path: root/src/shared/tonkadur/Tonkadur/Compute.elm

module Tonkadur.Compute exposing (compute)

-- Elm -------------------------------------------------------------------------
import Dict
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)