summaryrefslogtreecommitdiff
path: root/src/Tonkadur/Compute.elm
diff options
context:
space:
mode:
Diffstat (limited to 'src/Tonkadur/Compute.elm')
-rw-r--r--src/Tonkadur/Compute.elm292
1 files changed, 191 insertions, 101 deletions
diff --git a/src/Tonkadur/Compute.elm b/src/Tonkadur/Compute.elm
index 2a3410f..149f37d 100644
--- a/src/Tonkadur/Compute.elm
+++ b/src/Tonkadur/Compute.elm
@@ -18,15 +18,24 @@ add_text_effect : (
Tonkadur.Types.State ->
String ->
(List Tonkadur.Types.Computation) ->
+ (List Tonkadur.Types.Computation) ->
Tonkadur.Types.Value
)
add_text_effect state name parameters content =
- (TextValue
- (AugmentedText
+ (Tonkadur.Types.TextValue
+ (Tonkadur.Types.AugmentedText
{
- content = (List.map (compute state) content),
+ content =
+ (List.map
+ (\val ->
+ (Tonkadur.Types.value_to_text_or_string
+ (compute state val)
+ )
+ )
+ content
+ ),
effect_name = name,
- effect_parameters = parameters
+ effect_parameters = (List.map (compute state) parameters)
}
)
)
@@ -38,13 +47,19 @@ address : (
)
address state param =
case (compute state param) of
- (PointerValue address) -> (PointerValue address)
- (StringValue singleton) -> (PointerValue (List.singleton singleton))
- _ -> (PointerValue [])
+ (Tonkadur.Types.PointerValue address_v) ->
+ (Tonkadur.Types.PointerValue address_v)
+
+ (Tonkadur.Types.StringValue singleton) ->
+ (Tonkadur.Types.PointerValue (List.singleton singleton))
+
+ _ -> (Tonkadur.Types.PointerValue [])
unsupported_cast : String -> String -> Tonkadur.Types.Value
unsupported_cast from to =
- (StringValue ("Unsupported cast from " + from + " to " + to + "."))
+ (Tonkadur.Types.StringValue
+ ("Unsupported cast from " ++ from ++ " to " ++ to ++ ".")
+ )
cast : (
Tonkadur.Types.State ->
@@ -55,68 +70,84 @@ cast : (
)
cast state from to param =
case (compute state param) of
- (BoolValue bool) ->
+ (Tonkadur.Types.BoolValue bool) ->
case to of
"string" ->
if bool
- then (StringValue "true")
- else (StringValue "false")
+ then (Tonkadur.Types.StringValue "true")
+ else (Tonkadur.Types.StringValue "false")
"text" ->
if bool
- then (TextValue (StringText "true"))
- else (TextValue (StringText "false"))
+ then
+ (Tonkadur.Types.TextValue (Tonkadur.Types.StringText "true"))
+ else
+ (Tonkadur.Types.TextValue (Tonkadur.Types.StringText "false"))
- "bool" -> (BoolValue bool)
+ "bool" -> (Tonkadur.Types.BoolValue bool)
_ -> (unsupported_cast from to)
- (FloatValue float) ->
+ (Tonkadur.Types.FloatValue float) ->
case to of
- "string" -> (StringValue (String.fromFloat float))
- "text" -> (TextValue (StringText (String.fromFloat float)))
- "int" -> (IntValue (Math.floor float))
- "float" -> (FloatValue float)
+ "string" -> (Tonkadur.Types.StringValue (String.fromFloat float))
+ "text" ->
+ (Tonkadur.Types.TextValue
+ (Tonkadur.Types.StringText (String.fromFloat float))
+ )
+
+ "int" -> (Tonkadur.Types.IntValue (floor float))
+ "float" -> (Tonkadur.Types.FloatValue float)
_ -> (unsupported_cast from to)
- (IntValue int) ->
+ (Tonkadur.Types.IntValue int) ->
case to of
- "string" -> (StringValue (String.fromInt int))
- "text" -> (TextValue (StringText (String.fromInt int)))
- "float" -> (FloatValue (Math.toFloat int))
- "int" -> (IntValue int)
+ "string" -> (Tonkadur.Types.StringValue (String.fromInt int))
+ "text" ->
+ (Tonkadur.Types.TextValue
+ (Tonkadur.Types.StringText (String.fromInt int))
+ )
+
+ "float" -> (Tonkadur.Types.FloatValue (toFloat int))
+ "int" -> (Tonkadur.Types.IntValue int)
_ -> (unsupported_cast from to)
- (TextValue text) ->
- let as_string = (Tonkadur.Types.value_to_string (TextValue text)) in
+ (Tonkadur.Types.TextValue text_v) ->
+ let
+ as_string =
+ (Tonkadur.Types.value_to_string
+ (Tonkadur.Types.TextValue text_v)
+ )
+ in
case to of
- "string" -> (StringValue as_string)
+ "string" -> (Tonkadur.Types.StringValue as_string)
"float" ->
case (String.toFloat as_string) of
Nothing -> (unsupported_cast from to)
- (Just result) -> (FloatValue result)
+ (Just result) -> (Tonkadur.Types.FloatValue result)
"int" ->
case (String.toInt as_string) of
Nothing -> (unsupported_cast from to)
- (Just result) -> (IntValue result)
+ (Just result) -> (Tonkadur.Types.IntValue result)
- "text" -> (TextValue text)
+ "text" -> (Tonkadur.Types.TextValue text_v)
_ -> (unsupported_cast from to)
- (StringValue string) ->
+ (Tonkadur.Types.StringValue string) ->
case to of
- "string" -> (StringValue string)
+ "string" -> (Tonkadur.Types.StringValue string)
"float" ->
- case (String.fromFloat string) of
+ case (String.toFloat string) of
Nothing -> (unsupported_cast from to)
- (Just result) -> (FloatValue result)
+ (Just result) -> (Tonkadur.Types.FloatValue result)
"int" ->
case (String.toInt string) of
Nothing -> (unsupported_cast from to)
- (Just result) -> (IntValue result)
+ (Just result) -> (Tonkadur.Types.IntValue result)
- "text" -> (TextValue (StringText string))
+ "text" ->
+ (Tonkadur.Types.TextValue (Tonkadur.Types.StringText string))
_ -> (unsupported_cast from to)
@@ -129,7 +160,22 @@ constant : (
Tonkadur.Types.Value
)
constant state target_type as_string =
- (cast state "string" target_type as_string)
+ case target_type of
+ "string" -> (Tonkadur.Types.StringValue as_string)
+ "float" ->
+ case (String.toFloat as_string) of
+ Nothing -> (unsupported_cast as_string target_type)
+ (Just result) -> (Tonkadur.Types.FloatValue result)
+
+ "int" ->
+ case (String.toInt as_string) of
+ Nothing -> (unsupported_cast as_string target_type)
+ (Just result) -> (Tonkadur.Types.IntValue result)
+
+ "text" ->
+ (Tonkadur.Types.TextValue (Tonkadur.Types.StringText as_string))
+
+ _ -> (unsupported_cast as_string target_type)
extra_computation : (
Tonkadur.Types.State ->
@@ -139,7 +185,10 @@ extra_computation : (
)
extra_computation state name parameters =
case name of
- _ -> (StringValue ("Unsupported extra computation '" + name + "'"))
+ _ ->
+ (Tonkadur.Types.StringValue
+ ("Unsupported extra computation '" ++ name ++ "'")
+ )
if_else : (
Tonkadur.Types.State ->
@@ -149,21 +198,26 @@ if_else : (
Tonkadur.Types.Value
)
if_else state condition if_true if_false =
- if (WyrdType.to_boolean (compute state condition))
+ if (Tonkadur.Types.value_to_bool (compute state condition))
then (compute state if_true)
else (compute state if_false)
last_choice_index : Tonkadur.Types.State -> Tonkadur.Types.Value
-last_choice_index state = (IntValue state.last_choice_index)
+last_choice_index state = (Tonkadur.Types.IntValue state.last_choice_index)
newline : Tonkadur.Types.State -> Tonkadur.Types.Value
-newline state = (TextValue Newline)
+newline state = (Tonkadur.Types.TextValue Tonkadur.Types.NewlineText)
next_allocable_address : Tonkadur.Types.State -> Tonkadur.Types.Value
next_allocable_address state =
- if (List.isEmpty state.freed_addresses)
- then (PointerValue [(".alloc." ++ (String.fromInt state.allocated_data))])
- else (PointerValue [state.freed_addresses[0]])
+ case state.freed_addresses of
+ [] ->
+ (Tonkadur.Types.PointerValue
+ [(".alloc." ++ (String.fromInt state.allocated_data))]
+ )
+
+ (available_address :: _) ->
+ (Tonkadur.Types.PointerValue [available_address])
operation : (
Tonkadur.Types.State ->
@@ -180,11 +234,13 @@ operation state name param0 param1 =
case name of
"divide" ->
case value0 of
- (IntValue val) ->
- (IntValue (val // (Tonkadur.Types.value_to_int value1)))
+ (Tonkadur.Types.IntValue val) ->
+ (Tonkadur.Types.IntValue
+ (val // (Tonkadur.Types.value_to_int value1))
+ )
_ ->
- (FloatValue
+ (Tonkadur.Types.FloatValue
(
(Tonkadur.Types.value_to_float value0)
/ (Tonkadur.Types.value_to_float value1)
@@ -193,11 +249,13 @@ operation state name param0 param1 =
"minus" ->
case value0 of
- (IntValue val) ->
- (IntValue (val - (Tonkadur.Types.value_to_int value1)))
+ (Tonkadur.Types.IntValue val) ->
+ (Tonkadur.Types.IntValue
+ (val - (Tonkadur.Types.value_to_int value1))
+ )
_ ->
- (FloatValue
+ (Tonkadur.Types.FloatValue
(
(Tonkadur.Types.value_to_float value0)
- (Tonkadur.Types.value_to_float value1)
@@ -205,7 +263,7 @@ operation state name param0 param1 =
)
"modulo" ->
- (IntValue
+ (Tonkadur.Types.IntValue
(modBy
(Tonkadur.Types.value_to_int value0)
(Tonkadur.Types.value_to_int value1)
@@ -214,11 +272,13 @@ operation state name param0 param1 =
"plus" ->
case value0 of
- (IntValue val) ->
- (IntValue (val + (Tonkadur.Types.value_to_int value1)))
+ (Tonkadur.Types.IntValue val) ->
+ (Tonkadur.Types.IntValue
+ (val + (Tonkadur.Types.value_to_int value1))
+ )
_ ->
- (FloatValue
+ (Tonkadur.Types.FloatValue
(
(Tonkadur.Types.value_to_float value0)
+ (Tonkadur.Types.value_to_float value1)
@@ -227,11 +287,13 @@ operation state name param0 param1 =
"power" ->
case value0 of
- (IntValue val) ->
- (IntValue (val ^ (Tonkadur.Types.value_to_int value1)))
+ (Tonkadur.Types.IntValue val) ->
+ (Tonkadur.Types.IntValue
+ (val ^ (Tonkadur.Types.value_to_int value1))
+ )
_ ->
- (FloatValue
+ (Tonkadur.Types.FloatValue
(
(Tonkadur.Types.value_to_float value0)
^ (Tonkadur.Types.value_to_float value1)
@@ -240,11 +302,13 @@ operation state name param0 param1 =
"times" ->
case value0 of
- (IntValue val) ->
- (IntValue (val * (Tonkadur.Types.value_to_int value1)))
+ (Tonkadur.Types.IntValue val) ->
+ (Tonkadur.Types.IntValue
+ (val * (Tonkadur.Types.value_to_int value1))
+ )
_ ->
- (FloatValue
+ (Tonkadur.Types.FloatValue
(
(Tonkadur.Types.value_to_float value0)
* (Tonkadur.Types.value_to_float value1)
@@ -252,41 +316,57 @@ operation state name param0 param1 =
)
"and" ->
- (BoolValue
- (and
+ (Tonkadur.Types.BoolValue
+ (
(Tonkadur.Types.value_to_bool value0)
- (Tonkadur.Types.value_to_bool value1)
+ && (Tonkadur.Types.value_to_bool value1)
)
)
- "not" -> (BoolValue (not (Tonkadur.Types.value_to_bool value0)))
+ "not" ->
+ (Tonkadur.Types.BoolValue (not (Tonkadur.Types.value_to_bool value0)))
"less_than" ->
case value0 of
- (BoolValue bool) ->
- (and (Tonkadur.Types.value_to_bool value1) (not boot))
+ (Tonkadur.Types.BoolValue bool) ->
+ (Tonkadur.Types.BoolValue
+ ((Tonkadur.Types.value_to_bool value1) && (not bool))
+ )
- (FloatValue float) ->
- (BoolValue (float < (Tonkadur.Types.value_to_float value1)))
+ (Tonkadur.Types.FloatValue float) ->
+ (Tonkadur.Types.BoolValue
+ (float < (Tonkadur.Types.value_to_float value1))
+ )
- (IntValue int) ->
- (BoolValue (int < (Tonkadur.Types.value_to_int value1)))
+ (Tonkadur.Types.IntValue int) ->
+ (Tonkadur.Types.BoolValue
+ (int < (Tonkadur.Types.value_to_int value1))
+ )
- (StringValue str) ->
- (BoolValue (str < (Tonkadur.Types.value_to_string value1)))
+ (Tonkadur.Types.StringValue str) ->
+ (Tonkadur.Types.BoolValue
+ (str < (Tonkadur.Types.value_to_string value1))
+ )
- (PointerValue ptr) ->
- (BoolValue
+ (Tonkadur.Types.PointerValue ptr) ->
+ (Tonkadur.Types.BoolValue
(
(Tonkadur.Types.compare_pointers
ptr
- (Tonadur.Wyrd.value_to_dict value1)
+ (Tonkadur.Types.value_to_address value1)
)
> 0
)
)
- "equals" -> (value0 == value1)
+ _ -> (Tonkadur.Types.StringValue ("Not a comparable type."))
+
+ "equals" -> (Tonkadur.Types.BoolValue (value0 == value1))
+
+ other ->
+ (Tonkadur.Types.StringValue
+ ("Unknown operation '" ++ other ++ "'")
+ )
relative_address : (
Tonkadur.Types.State ->
@@ -295,10 +375,10 @@ relative_address : (
Tonkadur.Types.Value
)
relative_address state base extra =
- (PointerValue
+ (Tonkadur.Types.PointerValue
(List.append
- (Tonkadur.Types.value_to_list (compute state base))
- (Tonkadur.Types.value_to_list (compute state extra))
+ (Tonkadur.Types.value_to_address (compute state base))
+ (Tonkadur.Types.value_to_address (compute state extra))
)
)
@@ -308,7 +388,7 @@ size : (
Tonkadur.Types.Value
)
size state computation =
- (IntValue
+ (Tonkadur.Types.IntValue
(Dict.size (Tonkadur.Types.value_to_dict (compute state computation)))
)
@@ -321,14 +401,16 @@ text : (
text state content =
(List.foldl
(\addition result ->
- (TextValue
+ (Tonkadur.Types.TextValue
(Tonkadur.Types.append_text_content
- (Tonkadur.Types.value_to_text result)
- (Tonkadur.Types.value_to_text (compute state addition))
+ (Tonkadur.Types.value_to_text_or_string result)
+ (Tonkadur.Types.value_to_text_or_string (compute state addition))
)
)
)
- (TextValue (Tonkadur.Types.default_text_data))
+ (Tonkadur.Types.TextValue
+ (Tonkadur.Types.AugmentedText (Tonkadur.Types.default_text_data))
+ )
content
)
@@ -341,11 +423,14 @@ value_of state computation =
(List.foldl
(\next_step object ->
case (Dict.get next_step (Tonkadur.Types.value_to_dict object)) of
- Nothing -> (StringValue "Segmentation Fault (incorrect address)")
(Just value) -> value
+ Nothing ->
+ (Tonkadur.Types.StringValue
+ "Segmentation Fault (incorrect address)"
+ )
)
- (StructureValue state.memory)
- (Tonkadur.Types.value_to_list (compute state computation))
+ (Tonkadur.Types.StructureValue state.memory)
+ (Tonkadur.Types.value_to_address (compute state computation))
)
--------------------------------------------------------------------------------
@@ -358,23 +443,28 @@ compute : (
)
compute state computation =
case computation of
- (AddTextEffect effect_name effect_parameters content) ->
+ (Tonkadur.Types.AddTextEffect effect_name effect_parameters content) ->
(add_text_effect state effect_name effect_parameters content)
- (Address param) -> (address state param)
- (Cast from to value) -> (cast state from to value)
- (Constant true_type as_string) -> (constant state true_type as_string)
- (ExtraComputation name parameters) ->
+ (Tonkadur.Types.Address param) -> (address state param)
+ (Tonkadur.Types.Cast from to value) -> (cast state from to value)
+ (Tonkadur.Types.Constant true_type as_string) ->
+ (constant state true_type as_string)
+
+ (Tonkadur.Types.ExtraComputation name parameters) ->
(extra_computation state name parameters)
- (IfElse condition if_true if_false) ->
+ (Tonkadur.Types.IfElse condition if_true if_false) ->
(if_else state condition if_true if_false)
- LastChoiceIndex -> (last_choice_index state)
- Newline -> (newline state)
- NextAllocableAddress -> (next_allocable_address state)
- (Operation name arg_0 arg_1) -> (operation state name arg_0 arg_1)
- (RelativeAddress base extra) -> (relative_address state base extra)
- (Size value) -> (size state value)
- (Text content) -> (text state content)
- (ValueOf address) -> (value_of state address)
+ Tonkadur.Types.LastChoiceIndex -> (last_choice_index state)
+ Tonkadur.Types.Newline -> (newline state)
+ Tonkadur.Types.NextAllocableAddress -> (next_allocable_address state)
+ (Tonkadur.Types.Operation name arg_0 arg_1) ->
+ (operation state name arg_0 arg_1)
+ (Tonkadur.Types.RelativeAddress base extra) ->
+ (relative_address state base extra)
+
+ (Tonkadur.Types.Size value) -> (size state value)
+ (Tonkadur.Types.Text content) -> (text state content)
+ (Tonkadur.Types.ValueOf address_c) -> (value_of state address_c)