summaryrefslogtreecommitdiff |
diff options
author | Nathanael Sensfelder <SpamShield0@MultiAgentSystems.org> | 2021-12-26 00:44:28 +0100 |
---|---|---|
committer | Nathanael Sensfelder <SpamShield0@MultiAgentSystems.org> | 2021-12-26 00:44:28 +0100 |
commit | 6777c3edc9414e3a59f94f940756f8666e017a6e (patch) | |
tree | e68a775c36ea28b41d8d560aa30d3ec2d16b812f | |
parent | ef7fd312bedae718ab5070cda7e73e48d1a255cb (diff) |
Starting to integrate Tonkadur.
-rw-r--r-- | src/shared/tonkadur/Tonkadur/Compute.elm | 376 | ||||
-rw-r--r-- | src/shared/tonkadur/Tonkadur/Execute.elm | 303 | ||||
-rw-r--r-- | src/shared/tonkadur/Tonkadur/Types.elm | 214 |
3 files changed, 893 insertions, 0 deletions
diff --git a/src/shared/tonkadur/Tonkadur/Compute.elm b/src/shared/tonkadur/Tonkadur/Compute.elm new file mode 100644 index 0000000..b22c3ac --- /dev/null +++ b/src/shared/tonkadur/Tonkadur/Compute.elm @@ -0,0 +1,376 @@ +module Tonkadur.Compute exposing (compute) + +-- Elm ------------------------------------------------------------------------- +import List + +-- Tonkadur -------------------------------------------------------------------- +import Tonkadur.Types + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +add_text_effect : ( + Tonkadur.Types.State -> + String -> + (List.List Tonkadur.Types.Computation) -> + Tonkadur.Types.Value + ) +add_text_effect state name parameters content = + (TextValue + (AugmentedText + { + content = (List.map (compute state) content), + effect_name = name, + effect_parameters = parameters + } + ) + ) + +address : ( + Tonkadur.Types.State -> + Tonkadur.Types.Computation -> + Tonkadur.Types.Value + ) +address state param = + case (compute state param) of + (PointerValue address) -> (PointerValue address) + (StringValue singleton) -> (PointerValue (List.singleton singleton)) + _ -> (PointerValue (List.empty)) + +unsupported_cast : String -> String -> Tonkadur.Types.Value +unsupported_cast from to = + (StringValue ("Unsupported cast from " + from + " to " + to + ".")) + +cast : ( + Tonkadur.Types.State -> + String -> + String -> + Tonkadur.Types.Computation -> + Tonkadur.Types.Value + ) +cast state from to param = + case (compute state param) of + (BoolValue bool) -> + case to of + "string" -> + if bool + then (StringValue "true") + else (StringValue "false") + + "text" -> + if bool + then (TextValue (StringText "true")) + else (TextValue (StringText "false")) + + "bool" -> (BoolValue bool) + _ -> (unsupported_cast from to) + + (FloatValue float) -> + case to of + "string" -> (StringValue (String.fromFloat float)) + "text" -> (TextValue (StringText (String.fromFloat float))) + "int" -> (IntValue (Math.floor float)) + "float" -> (FloatValue float) + _ -> (unsupported_cast from to) + + (IntValue int) -> + case to of + "string" -> (StringValue (String.fromInt int)) + "text" -> (TextValue (StringText (String.fromInt int))) + "float" -> (FloatValue (Math.toFloat int)) + "int" -> (IntValue int) + _ -> (unsupported_cast from to) + + (TextValue text) -> + let as_string = (Tonkadur.Types.value_to_string (TextValue text)) in + case to of + "string" -> (StringValue as_string) + "float" -> + case (String.toFloat as_string) of + Nothing -> (unsupported_cast from to) + (Just result) -> (FloatValue result) + + "int" -> + case (String.toInt as_string) of + Nothing -> (unsupported_cast from to) + (Just result) -> (IntValue result) + + "text" -> (TextValue text) + _ -> (unsupported_cast from to) + + (StringValue string) -> + case to of + "string" -> (StringValue string) + "float" -> + case (String.fromFloat string) of + Nothing -> (unsupported_cast from to) + (Just result) -> (FloatValue result) + + "int" -> + case (String.toInt string) of + Nothing -> (unsupported_cast from to) + (Just result) -> (IntValue result) + + "text" -> (TextValue (StringText string)) + + _ -> (unsupported_cast from to) + + _ -> (unsupported_cast from to) + +constant : ( + Tonkadur.Types.State -> + String -> + String -> + Tonkadur.Types.Value + ) +constant state target_type as_string = + (cast state "string" target_type as_string) + +extra_computation : ( + Tonkadur.Types.State -> + String -> + (List.List Tonkadur.Types.Computation) -> + Tonkadur.Types.Value + ) +extra_computation state name parameters = + case name of + _ -> (StringValue ("Unsupported extra computation '" + name + "'")) + +if_else : ( + Tonkadur.Types.State -> + Tonkadur.Types.Computation -> + Tonkadur.Types.Computation -> + Tonkadur.Types.Computation -> + Tonkadur.Types.Value + ) +if_else state condition if_true if_false = + if (WyrdType.to_boolean (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) + +newline : Tonkadur.Types.State -> Tonkadur.Types.Value +newline state = (TextValue Newline) + +next_allocable_address : Tonkadur.Types.State -> Tonkadur.Types.Value +next_allocable_address state = (IntValue state.next_allocable_address) + +operation : ( + Tonkadur.Types.State -> + String -> + Tonkadur.Types.Computation -> + Tonkadur.Types.Computation -> + Tonkadur.Types.Value + ) +operation state name param0 param1 = + let + value0 = (compute state param0) + value1 = (compute state param1) + in + case name of + "divide" -> + case value0 of + (IntValue val) -> + (IntValue (val // (Tonkadur.Types.value_to_int value1))) + + _ -> + (FloatValue + ( + (Tonkadur.Types.value_to_float value0) + / (Tonkadur.Types.value_to_float value1) + ) + ) + + "minus" -> + case value0 of + (IntValue val) -> + (IntValue (val - (Tonkadur.Types.value_to_int value1))) + + _ -> + (FloatValue + ( + (Tonkadur.Types.value_to_float value0) + - (Tonkadur.Types.value_to_float value1) + ) + ) + + "modulo" -> + (IntValue + (modBy + (Tonkadur.Types.value_to_int value0) + (Tonkadur.Types.value_to_int value1) + ) + ) + + "plus" -> + case value0 of + (IntValue val) -> + (IntValue (val + (Tonkadur.Types.value_to_int value1))) + + _ -> + (FloatValue + ( + (Tonkadur.Types.value_to_float value0) + + (Tonkadur.Types.value_to_float value1) + ) + ) + + "power" -> + case value0 of + (IntValue val) -> + (IntValue (val ^ (Tonkadur.Types.value_to_int value1))) + + _ -> + (FloatValue + ( + (Tonkadur.Types.value_to_float value0) + ^ (Tonkadur.Types.value_to_float value1) + ) + ) + + "times" -> + case value0 of + (IntValue val) -> + (IntValue (val * (Tonkadur.Types.value_to_int value1))) + + _ -> + (FloatValue + ( + (Tonkadur.Types.value_to_float value0) + * (Tonkadur.Types.value_to_float value1) + ) + ) + + "and" -> + (BoolValue + (and + (Tonkadur.Types.value_to_bool value0) + (Tonkadur.Types.value_to_bool value1) + ) + ) + + "not" -> (BoolValue (not (Tonkadur.Types.value_to_bool value0))) + + "less_than" -> + case value0 of + (BoolValue bool) -> + (and (Tonkadur.Types.value_to_bool value1) (not boot)) + + (FloatValue float) -> + (BoolValue (float < (Tonkadur.Types.value_to_float value1))) + + (IntValue int) -> + (BoolValue (int < (Tonkadur.Types.value_to_int value1))) + + (StringValue str) -> + (BoolValue (str < (Tonkadur.Types.value_to_string value1))) + + (PointerValue ptr) -> + (BoolValue + ( + (Tonkadur.Types.compare_pointers + ptr + (Tonadur.Wyrd.value_to_dict value1) + ) + > 0 + ) + ) + + "equals" -> (value0 == value1) + +relative_address : ( + Tonkadur.Types.State -> + Tonkadur.Types.Computation -> + Tonkadur.Types.Computation -> + Tonkadur.Types.Value + ) +relative_address state base extra = + (PointerValue + (List.append + (Tonkadur.Types.value_to_list (compute state base)) + (Tonkadur.Types.value_to_list (compute state extra)) + ) + ) + +size : ( + Tonkadur.Types.State -> + Tonkadur.Types.Computation -> + Tonkadur.Types.Value + ) +size state computation = + (IntValue + (Dict.size (Tonkadur.Types.value_to_dict (compute state computation))) + ) + + +text : ( + Tonkadur.Types.State -> + (List.List Tonkadur.Types.Computation) -> + Tonkadur.Types.Value + ) +text state content = + (List.foldl + (\addition result -> + (TextValue + (Tonkadur.Types.append_text_content + (Tonkadur.Types.value_to_text result) + (Tonkadur.Types.value_to_text (compute state addition)) + ) + ) + ) + (TextValue (Tonkadur.Types.default_text_data)) + content + ) + +value_of : ( + Tonkadur.Types.State -> + Tonkadur.Types.Computation -> + Tonkadur.Types.Value + ) +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 + ) + (StructureValue state.memory) + (Tonkadur.Types.value_to_list (compute state computation)) + ) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +compute : ( + Tonkadur.Types.State -> + Tonkadur.Types.Computation -> + Tonkadur.Types.Value + ) +compute state computation = + case computation of + (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) -> + (extra_computation state name parameters) + + (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) diff --git a/src/shared/tonkadur/Tonkadur/Execute.elm b/src/shared/tonkadur/Tonkadur/Execute.elm new file mode 100644 index 0000000..ebdd943 --- /dev/null +++ b/src/shared/tonkadur/Tonkadur/Execute.elm @@ -0,0 +1,303 @@ +module Tonkadur.Execute exposing (execute) + +-- Elm ------------------------------------------------------------------------- +import List + +-- Tonkadur -------------------------------------------------------------------- +import Tonkadur.Types + +import Tonkadur.Compute + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +---- UPDATE MEMORY ------------------------------------------------------------- +apply_at_address : ( + (List.List String) -> + ( + String -> + (Dict.Dict String Value) -> + (Dict.Dict String Value) + ) + (Dict.Dict String Value) -> + (Dict.Dict String Value) + ) +apply_at_address address fun memory = + case address of + [] -> memory + (last_element :: []) -> (fun last_element memory) + (next_element :: next_address) -> + (Dict.update + next_element + (\maybe_value -> + case maybe_value of + (Just value) -> + (Just + (apply_at_address + next_address + fun + (Tonkadur.Types.value_to_dict value) + ) + ) + + Nothing -> Nothing + ) + ) + +---- INSTRUCTIONS -------------------------------------------------------------- +add_event_option : ( + String -> + (List.List Tonkadur.Types.Computation) -> + Tonkadur.Types.State -> + Tonkadur.Types.State -> + ) +add_event_option name parameters state = + (Tonkadur.Types.append_option + (Event name (List.map (Tonkadur.Compute.compute state) parameters)) + state + ) + +add_text_option : ( + Tonkadur.Types.Computation -> + Tonkadur.Types.State -> + Tonkadur.Types.State + ) +add_text_option label state = + (Tonkadur.Types.append_option + (Choice (Tonkadur.Compute.compute label state)) + state + ) + +assert : ( + Tonkadur.Types.Computation -> + Tonkadur.Types.Computation -> + Tonkadur.Types.State -> + Tonkadur.Types.State + ) +assert condition label state = + if (Tonkadur.Types.value_to_bool (Tonkadur.Compute.compute state condition)) + then + -- TODO: some special error report + state + else state + +display : ( + Tonkadur.Types.Computation -> + Tonkadur.Types.State -> + Tonkadur.Types.State +) +display label state = + -- TODO: where do we put displayed values? + state + +end : Tonkadur.Types.State -> Tonkadur.Types.State +end state = + -- TODO: what do we do with this? + state + +extra_instruction : ( + String -> + (List.List Tonkadur.Types.Computation) -> + Tonkadur.Types.State -> + Tonkadur.Types.State + ) +extra_instruction name parameters state = + -- No extra instruction supported. + -- TODO: error report. + +initialize : ( + String -> + Tonkadur.Types.Computation -> + Tonkadur.Types.State -> + Tonkadur.Types.State + ) +initialize type_name address state = + {state | + memory = + (apply_at_address + (Tonkadur.Types.value_to_list + (Tonkadur.Compute.compute state address) + ) + (\last_addr dict -> + (Dict.insert + last_addr + (Tonkadur.Types.get_default state type_name) + dict + ) + ) + state.memory + ) + } + +prompt_command : ( + Tonkadur.Types.Computation -> + Tonkadur.Types.Computation -> + Tonkadur.Types.Computation -> + Tonkadur.Types.Computation -> + Tonkadur.Types.State -> + Tonkadur.Types.State + ) +prompt_command address min max label state = + -- TODO: how to prompt for input? + state + +prompt_integer : ( + Tonkadur.Types.Computation -> + Tonkadur.Types.Computation -> + Tonkadur.Types.Computation -> + Tonkadur.Types.Computation -> + Tonkadur.Types.State -> + Tonkadur.Types.State + ) +prompt_integer address min max label state = + -- TODO: how to prompt for input? + state + +prompt_string : ( + Tonkadur.Types.Computation -> + Tonkadur.Types.Computation -> + Tonkadur.Types.Computation -> + Tonkadur.Types.Computation -> + Tonkadur.Types.State -> + Tonkadur.Types.State + ) +prompt_integer address min max label state = + -- TODO: how to prompt for input? + state + +remove : ( + Tonkadur.Types.Computation -> + Tonkadur.Types.State -> + Tonkadur.Types.State + ) +remove address state = + {state | + memory = + (apply_at_address + (Tonkadur.Types.value_to_list + (Tonkadur.Compute.compute state address) + ) + (\last_addr dict -> (Dict.remove last_addr dict)) + state.memory + ) + } + +resolve_choice : Tonkadur.Types.State -> Tonkadur.Types.State +resolve_choice state = + -- TODO: how to prompt for input? + state + +set_pc : ( + Tonkadur.Types.Computation -> + Tonkadur.Types.State -> + Tonkadur.Types.State +) +set_pc value state = + {state | + program_counter = + (Tonkadur.Types.value_to_int + (Tonkadur.Compute.compute state value) + ) + } + +set_random : ( + Tonkadur.Types.Computation -> + Tonkadur.Types.Computation -> + Tonkadur.Types.Computation -> + Tonkadur.Types.State -> + Tonkadur.Types.State +) +set_random address min max state = + let + (value, next_random_seed) = + (Random.step + (Random.int + (Tonkadur.Types.value_to_int + (Tonkadur.Compute.compute state min) + (Tonkadur.Compute.compute state max) + ) + ) + state.random_seed + ) + in + {state | + memory = + (apply_at_address + (Tonkadur.Types.value_to_list + (Tonkadur.Compute.compute state address) + ) + (\last_addr dict -> (Dict.insert last_addr (IntValue value) dict)) + state.memory + ), + + random_seed = next_random_seed + } + +set : ( + Tonkadur.Types.Computation -> + Tonkadur.Types.Computation -> + Tonkadur.Types.State -> + Tonkadur.Types.State +) +set address value state = + {state | + memory = + (apply_at_address + (Tonkadur.Types.value_to_list + (Tonkadur.Compute.compute state address) + ) + (\last_addr dict -> + (Dict.insert + last_addr + (Tonkadur.Compute.compute state value) + dict + ) + ) + state.memory + ) + } + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +execute : ( + Tonkadur.Types.Instruction -> + Tonkadur.Types.State -> + Tonkadur.Types.State -> + ) +execute instruction state = + case instruction of + (AddEventOption name parameters) -> + (add_event_option name parameters state) + + (AddTextOption label) -> + (add_text_option name parameters state) + + (Assert condition label) -> + (assert condition label state) + + (Display label) -> (display label state) + End -> (end state) + (ExtraInstruction name parameters) -> + (extra_instruction name parameters state) + + (Initialize type_name address) -> (initialize type_name address state) + (PromptCommand address min max label) -> + (prompt_command address min max label state) + + (PromptInteger address min max label) -> + (prompt_integer address min max label state) + + (PromptString address min max label) -> + (prompt_string address min max label state) + + (Remove address) -> (remove address state) + ResolveChoice -> (resolve_choice state) + (SetPC value) -> (set_pc value state) + (SetRandom address min max) -> (set_random address min max state) + (Set address value) -> (set address value state) + diff --git a/src/shared/tonkadur/Tonkadur/Types.elm b/src/shared/tonkadur/Tonkadur/Types.elm new file mode 100644 index 0000000..1e2be63 --- /dev/null +++ b/src/shared/tonkadur/Tonkadur/Types.elm @@ -0,0 +1,214 @@ +module Tonkadur.Wyrd exposing (..) + +-- Elm ------------------------------------------------------------------------- +import Dict +import List + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type alias TextData = + { + content : (List.List RichText), + effect_name : String, + effect_parameters : (List.List Value) + } + +type RichText = + StringText String + | AugmentedText TextData + | Newline + +type Value = + BoolValue Bool + | FloatValue Float + | IntValue Int + | TextValue RichText + | StringValue String + | ListValue (Dict.Dict String Value) + | PointerValue (List.List String) + | StructureValue (Dict.Dict String Value) + +type Option = + Choice RichText + | Event (String, (List.List Value)) + +type Computation = + AddTextEffect (String, (List.List Computation), (List.List Computation)) + | Address Computation + | Cast (String, String, Computation) + | Constant (String, String) + | ExtraComputation (String, (List.List Computation)) + | IfElse (Computation, Computation, Computation) + | LastChoiceIndex + | Newline + | NextAllocableAddress + | Operation (String, Computation, Computation) + | RelativeAddress (Computation, Computation) + | Size Computation + | Text (List.List Computation) + | ValueOf Computation + +type Instruction = + AddEventOption (String, (List.List Computation)) + | AddTextOption Computation + | Assert (Computation, Computation) + | Display Computation + | End + | ExtraInstruction (String, (List.List Computation)) + | Initialize (String, Computation) + | PromptCommand (Computation, Computation, Computation, Computation) + | PromptInteger (Computation, Computation, Computation, Computation) + | PromptString (Computation, Computation, Computation, Computation) + | Remove Computation + | ResolveChoice + | SetPC Computation + | SetRandom (Computation, Computation, Computation) + | Set (Computation, Computation) + +type alias State = + { + memory : (Dict.Dict String Value) + user_types : (Dict.Dict String Value), + sequences : (Dict.Dict String Int), + code : (List.List Instruction), + program_counter : Int, + allocated_data : Int, + last_choice_index : Int, + available_options : (List.List Option), + memorized_target : Value + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +value_to_bool : Value -> Bool +value_to_bool value = + case value of + (BoolValue result) -> result + _ -> False + +value_to_float : Value -> Float +value_to_float value = + case value of + (FloatValue result) -> result + _ -> 0.0 + +value_to_int : Value -> Int +value_to_int value = + case value of + (IntValue result) -> result + _ -> 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 "") + +value_to_string : Value -> String +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 (value_to_string) rich_text.content) + ) + + Newline -> "\n" + + _ -> (StringText "") + +value_to_dict : Value -> (Dict.Dict String Value) +value_to_dict value = + case value of + (StructureValue dict) -> dict + (ListValue dict) -> dict + _ -> (Dict.empty) + +value_to_address : Value -> (List.List String) +value_to_address value = + case value of + (PointerValue result) -> result + _ -> (List.empty) + +no_text_effect : String +no_text_effect = "" + +type RichText = + StringText String + | AugmentedText TextData + | Newline + +append_text_content : RichText -> RichText -> RichText +append_text_content base addition = + case base of + (AugmentedText text_data) -> + case addition of + (AugmentedText other_text_data) -> + -- Optimize text to avoid increasing depth if no new effect is + -- introduced. + if (other_text_data.effect_name == (no_text_effect)) + then + {base | + content = + (List.append base.content other_text_data.content) + } + else + {base | + content = + (List.append + base.content + (List.singleton other_text_data) + ) + } + + other -> + {base | + content = + (List.append base.content (List.singleton other_text_data)) + } + + non_augmented_text_data -> + (append_text_content + (append_text_content (AugmentedText (default_text_data)) base) + addition + ) + +default_text_data : TextData +default_text_data = + { + effect_name = (no_text_effect), + effect_parameters = (List.empty), + content = (List.empty) + } + +append_option : Option -> State -> State +append_option option state = + {state | + available_options = + (List.append state.available_options (List.singleton option)) + } + +get_default : State -> String -> Value +get_default state type_name = + case type_name of + "bool" -> (BoolValue False) + "float" -> (FloatValue 0.0) + "int" -> (IntValue 0) + "text" -> (TextValue (StringText "")) + "string" -> (StringValue "") + "list" -> (ListValue (Dict.empty)) + "ptr" -> (PointerValue (List.empty)) + other -> + case (Dict.get other state.user_types) of + (Just default) -> default + Nothing -> (StringValue ("Unknown type '" + other + "'")) |