summaryrefslogtreecommitdiff
path: root/src/Tonkadur
diff options
context:
space:
mode:
Diffstat (limited to 'src/Tonkadur')
-rw-r--r--src/Tonkadur/Compute.elm104
-rw-r--r--src/Tonkadur/Execute.elm6
-rw-r--r--src/Tonkadur/Json.elm4
-rw-r--r--src/Tonkadur/Types.elm104
4 files changed, 190 insertions, 28 deletions
diff --git a/src/Tonkadur/Compute.elm b/src/Tonkadur/Compute.elm
index a75ef7c..182d812 100644
--- a/src/Tonkadur/Compute.elm
+++ b/src/Tonkadur/Compute.elm
@@ -1,6 +1,7 @@
module Tonkadur.Compute exposing (compute)
-- Elm -------------------------------------------------------------------------
+import Debug
import Dict
import List
@@ -61,6 +62,20 @@ unsupported_cast from to =
("Unsupported cast from " ++ from ++ " to " ++ to ++ ".")
)
+unsupported_cast_with_hint : String -> String -> String -> Tonkadur.Types.Value
+unsupported_cast_with_hint from to hint =
+ (Tonkadur.Types.StringValue
+ (
+ "Unsupported cast from "
+ ++ from
+ ++ " to "
+ ++ to
+ ++ " (original value was \""
+ ++ hint
+ ++ "\")"
+ )
+ )
+
cast : (
Tonkadur.Types.State ->
String ->
@@ -69,7 +84,8 @@ cast : (
Tonkadur.Types.Value
)
cast state from to param =
- case (compute state param) of
+ let original_value = (compute state param) in
+ case original_value of
(Tonkadur.Types.BoolValue bool) ->
case to of
"string" ->
@@ -85,7 +101,14 @@ cast state from to param =
(Tonkadur.Types.TextValue (Tonkadur.Types.StringText "false"))
"bool" -> (Tonkadur.Types.BoolValue bool)
- _ -> (unsupported_cast from to)
+ _ ->
+ (Debug.log
+ (
+ "Failed cast: "
+ ++ (Tonkadur.Types.debug_value_to_string original_value)
+ )
+ (unsupported_cast from to)
+ )
(Tonkadur.Types.FloatValue float) ->
case to of
@@ -97,7 +120,14 @@ cast state from to param =
"int" -> (Tonkadur.Types.IntValue (floor float))
"float" -> (Tonkadur.Types.FloatValue float)
- _ -> (unsupported_cast from to)
+ _ ->
+ (Debug.log
+ (
+ "Failed cast: "
+ ++ (Tonkadur.Types.debug_value_to_string original_value)
+ )
+ (unsupported_cast from to)
+ )
(Tonkadur.Types.IntValue int) ->
case to of
@@ -110,7 +140,14 @@ cast state from to param =
"float" -> (Tonkadur.Types.FloatValue (toFloat int))
"bool" -> (Tonkadur.Types.BoolValue (not (int == 0)))
"int" -> (Tonkadur.Types.IntValue int)
- _ -> (unsupported_cast from to)
+ _ ->
+ (Debug.log
+ (
+ "Failed cast: "
+ ++ (Tonkadur.Types.debug_value_to_string original_value)
+ )
+ (unsupported_cast from to)
+ )
(Tonkadur.Types.TextValue text_v) ->
let
@@ -123,12 +160,12 @@ cast state from to param =
"string" -> (Tonkadur.Types.StringValue as_string)
"float" ->
case (String.toFloat as_string) of
- Nothing -> (unsupported_cast from to)
+ Nothing -> (unsupported_cast_with_hint from to as_string)
(Just result) -> (Tonkadur.Types.FloatValue result)
"int" ->
case (String.toInt as_string) of
- Nothing -> (unsupported_cast from to)
+ Nothing -> (unsupported_cast_with_hint from to as_string)
(Just result) -> (Tonkadur.Types.IntValue result)
"bool" ->
@@ -137,19 +174,26 @@ cast state from to param =
)
"text" -> (Tonkadur.Types.TextValue text_v)
- _ -> (unsupported_cast from to)
+ _ ->
+ (Debug.log
+ (
+ "Failed cast: "
+ ++ (Tonkadur.Types.debug_value_to_string original_value)
+ )
+ (unsupported_cast from to)
+ )
(Tonkadur.Types.StringValue string) ->
case to of
"string" -> (Tonkadur.Types.StringValue string)
"float" ->
case (String.toFloat string) of
- Nothing -> (unsupported_cast from to)
+ Nothing -> (unsupported_cast_with_hint from to string)
(Just result) -> (Tonkadur.Types.FloatValue result)
"int" ->
case (String.toInt string) of
- Nothing -> (unsupported_cast from to)
+ Nothing -> (unsupported_cast_with_hint from to string)
(Just result) -> (Tonkadur.Types.IntValue result)
"bool" ->
@@ -160,9 +204,23 @@ cast state from to param =
"text" ->
(Tonkadur.Types.TextValue (Tonkadur.Types.StringText string))
- _ -> (unsupported_cast from to)
+ _ ->
+ (Debug.log
+ (
+ "Failed cast: "
+ ++ (Tonkadur.Types.debug_value_to_string original_value)
+ )
+ (unsupported_cast from to)
+ )
- _ -> (unsupported_cast from to)
+ _ ->
+ (Debug.log
+ (
+ "Failed cast: "
+ ++ (Tonkadur.Types.debug_value_to_string original_value)
+ )
+ (unsupported_cast from to)
+ )
constant : (
Tonkadur.Types.State ->
@@ -175,17 +233,19 @@ constant state target_type as_string =
"string" -> (Tonkadur.Types.StringValue as_string)
"float" ->
case (String.toFloat as_string) of
- Nothing -> (unsupported_cast as_string target_type)
+ Nothing -> (unsupported_cast_with_hint as_string target_type as_string)
(Just result) -> (Tonkadur.Types.FloatValue result)
"int" ->
case (String.toInt as_string) of
- Nothing -> (unsupported_cast as_string target_type)
+ Nothing -> (unsupported_cast_with_hint as_string target_type as_string)
(Just result) -> (Tonkadur.Types.IntValue result)
"text" ->
(Tonkadur.Types.TextValue (Tonkadur.Types.StringText as_string))
+ "bool" -> (Tonkadur.Types.BoolValue (as_string == "true"))
+
_ -> (unsupported_cast as_string target_type)
extra_computation : (
@@ -389,7 +449,7 @@ relative_address state base extra =
(Tonkadur.Types.PointerValue
(List.append
(Tonkadur.Types.value_to_address (compute state base))
- (Tonkadur.Types.value_to_address (compute state extra))
+ [Tonkadur.Types.value_to_string (compute state extra)]
)
)
@@ -400,7 +460,9 @@ size : (
)
size state computation =
(Tonkadur.Types.IntValue
- (Dict.size (Tonkadur.Types.value_to_dict (compute state computation)))
+ (Dict.size
+ (Tonkadur.Types.value_to_dict (value_of state computation))
+ )
)
@@ -436,8 +498,16 @@ value_of state computation =
case (Dict.get next_step (Tonkadur.Types.value_to_dict object)) of
(Just value) -> value
Nothing ->
- (Tonkadur.Types.StringValue
- "Segmentation Fault (incorrect address)"
+ (Debug.log
+ (
+ "No "
+ ++ next_step
+ ++ " in "
+ ++ (Tonkadur.Types.debug_value_to_string object)
+ )
+ (Tonkadur.Types.StringValue
+ "Segmentation Fault (incorrect address)"
+ )
)
)
(Tonkadur.Types.StructureValue state.memory)
diff --git a/src/Tonkadur/Execute.elm b/src/Tonkadur/Execute.elm
index a65df88..865687b 100644
--- a/src/Tonkadur/Execute.elm
+++ b/src/Tonkadur/Execute.elm
@@ -273,7 +273,7 @@ set_random : (
Tonkadur.Types.State ->
Tonkadur.Types.State
)
-set_random address min max state =
+set_random min max address state =
let
(value, next_random_seed) =
(Random.step
@@ -378,8 +378,8 @@ execute instruction state =
(increment_program_counter (resolve_choice new_state))
(Tonkadur.Types.SetPC value) -> (set_pc value new_state)
- (Tonkadur.Types.SetRandom address min max) ->
- (increment_program_counter (set_random address min max new_state))
+ (Tonkadur.Types.SetRandom min max address) ->
+ (increment_program_counter (set_random min max address new_state))
(Tonkadur.Types.SetValue address value) ->
(increment_program_counter (set_value address value new_state))
diff --git a/src/Tonkadur/Json.elm b/src/Tonkadur/Json.elm
index d7ae3b3..fbdbcfe 100644
--- a/src/Tonkadur/Json.elm
+++ b/src/Tonkadur/Json.elm
@@ -53,7 +53,7 @@ specific_computation_decoder name =
(\from to value -> (Tonkadur.Types.Cast from to value))
(Json.Decode.field "from" (Json.Decode.string))
(Json.Decode.field "to" (Json.Decode.string))
- (Json.Decode.field "content" (computation_decoder))
+ (Json.Decode.field "value" (computation_decoder))
)
"constant" ->
@@ -357,7 +357,7 @@ sequences_decoder =
(Json.Decode.map2
(\name line -> (name, line))
(Json.Decode.field "name" (Json.Decode.string))
- (Json.Decode.field "value" (Json.Decode.int))
+ (Json.Decode.field "line" (Json.Decode.int))
)
)
)
diff --git a/src/Tonkadur/Types.elm b/src/Tonkadur/Types.elm
index 2a4df76..7b10e40 100644
--- a/src/Tonkadur/Types.elm
+++ b/src/Tonkadur/Types.elm
@@ -135,26 +135,42 @@ value_to_bool : Value -> Bool
value_to_bool value =
case value of
(BoolValue result) -> result
- _ -> False
+ _ ->
+ (Debug.log
+ ("Can't value_to_bool " ++ (debug_value_to_string value))
+ False
+ )
value_to_float : Value -> Float
value_to_float value =
case value of
(FloatValue result) -> result
- _ -> 0.0
+ _ ->
+ (Debug.log
+ ("Can't value_to_float " ++ (debug_value_to_string value))
+ 0.0
+ )
value_to_int : Value -> Int
value_to_int value =
case value of
(IntValue result) -> result
- _ -> 0
+ _ ->
+ (Debug.log
+ ("Can't value_to_int " ++ (debug_value_to_string value))
+ 0
+ )
value_to_text_or_string : Value -> RichText
value_to_text_or_string value =
case value of
(TextValue result) -> result
(StringValue string) -> (StringText string)
- _ -> (StringText "")
+ _ ->
+ (Debug.log
+ ("Can't value_to_text_or_string" ++ (debug_value_to_string value))
+ (StringText "")
+ )
value_to_string : Value -> String
value_to_string value =
@@ -175,18 +191,93 @@ value_to_string value =
_ -> "Cannot turn this value into string without cast."
+debug_value_to_string : Value -> String
+debug_value_to_string value =
+ case value of
+ (StringValue result) -> result
+ (TextValue text) ->
+ case text of
+ (StringText result) -> result
+ (AugmentedText rich_text) ->
+ (String.concat
+ (List.map
+ (\text_value -> (value_to_string (TextValue text_value)))
+ rich_text.content
+ )
+ )
+
+ NewlineText -> "\n"
+ (BoolValue bool) ->
+ if (bool)
+ then "true"
+ else "false"
+
+ (FloatValue float) -> (String.fromFloat float)
+ (IntValue int) -> (String.fromInt int)
+ (ListValue dict) ->
+ (
+ "["
+ ++
+ (String.join
+ ", "
+ (List.map
+ (\(key, val) ->
+ (
+ key
+ ++ ": "
+ ++ (debug_value_to_string val)
+ )
+ )
+ (Dict.toList dict)
+ )
+ )
+ ++
+ "]"
+ )
+
+ (PointerValue list) -> ("(addr [" ++ (String.join ", " list) ++ "])")
+ (StructureValue dict) ->
+ (
+ "["
+ ++
+ (String.join
+ ", "
+ (List.map
+ (\(key, val) ->
+ (
+ key
+ ++ ": "
+ ++ (debug_value_to_string val)
+ )
+ )
+ (Dict.toList dict)
+ )
+ )
+ ++
+ "]"
+ )
+
+
value_to_dict : Value -> (Dict.Dict String Value)
value_to_dict value =
case value of
(StructureValue dict) -> dict
(ListValue dict) -> dict
- _ -> (Dict.empty)
+ _ ->
+ (Debug.log
+ ("Can't value_to_dict" ++ (debug_value_to_string value))
+ (Dict.empty)
+ )
value_to_address : Value -> (List String)
value_to_address value =
case value of
(PointerValue result) -> result
- _ -> []
+ _ ->
+ (Debug.log
+ ("Can't value_to_adress " ++ (debug_value_to_string value))
+ []
+ )
no_text_effect : String
no_text_effect = ""
@@ -271,6 +362,7 @@ maybe_get_default_primitive type_name =
"string" -> (Just (StringValue ""))
"list" -> (Just (ListValue (Dict.empty)))
"ptr" -> (Just (PointerValue []))
+ "wild dict" -> (Just (StructureValue (Dict.empty)))
_ -> Nothing
apply_at_address : (