diff --git a/app/elm/Environment.elm b/app/elm/Environment.elm index bde9348..fcea927 100644 --- a/app/elm/Environment.elm +++ b/app/elm/Environment.elm @@ -1,6 +1,5 @@ module Environment exposing - ( Arrays - , Environment + ( Environment , Object(..) , back , clean @@ -25,25 +24,20 @@ module Environment exposing environment: the state of the turtle, console output etc. -} -import Array exposing (Array) import Color exposing (Color) -import Dict exposing (Dict) +import Dict import Environment.History as History exposing (Entry(..), History) import Environment.Line as Line exposing (Line) import Environment.Turtle as Turtle exposing (State(..), Turtle) import Json.Encode as E import Math.Vector2 as Vec2 exposing (Vec2) -import Vm.Type as Type +import Vm.Stack exposing (Arrays) type Object = Line Line -type alias Arrays = - Dict Int { items : Array Type.Value, origin : Int, id : Maybe Int } - - type alias Environment = { history : History , objects : List ( Int, Object ) diff --git a/app/elm/Vm/Stack.elm b/app/elm/Vm/Stack.elm index 3461121..03d24a4 100644 --- a/app/elm/Vm/Stack.elm +++ b/app/elm/Vm/Stack.elm @@ -1,12 +1,13 @@ module Vm.Stack exposing - ( PrimitiveValue(..) + ( Arrays + , PrimitiveValue(..) , Stack , Value(..) , toValue ) -import Dict -import Environment exposing (Arrays) +import Array exposing (Array) +import Dict exposing (Dict) import Json.Encode as E import Vm.Type as Type @@ -32,6 +33,10 @@ type alias Stack = List Value +type alias Arrays = + Dict Int { items : Array PrimitiveValue, origin : Int, id : Maybe Int } + + encodeValue : Arrays -> Value -> E.Value encodeValue arrays value = case value of @@ -62,6 +67,17 @@ toTypeValue arrays value = ArrayId id -> Dict.get id arrays + |> Maybe.map + (\array -> + let + { items, origin } = + array + + typeItems = + Array.map (toTypeValue arrays) items + in + { items = typeItems, origin = origin, id = Just id } + ) |> Maybe.map Type.Array |> Maybe.withDefault (Type.Word "") diff --git a/app/elm/Vm/Vm.elm b/app/elm/Vm/Vm.elm index a588b24..f6775b9 100644 --- a/app/elm/Vm/Vm.elm +++ b/app/elm/Vm/Vm.elm @@ -257,6 +257,27 @@ toTypeValue value vm = Stack.ArrayId id -> Dict.get id vm.environment.arrays |> Result.fromMaybe (Internal ArrayNotFound) + |> Result.andThen + (\array -> + let + { items, origin } = + array + + typeItems = + Array.foldl + (\value_ acc -> Result.map2 (::) (toTypeValue value_ vm) acc) + (Ok []) + items + in + typeItems + |> Result.map + (\typeItems_ -> + { items = Array.fromList typeItems_ + , origin = origin + , id = Just id + } + ) + ) |> Result.map Type.Array @@ -301,8 +322,23 @@ toStackPrimitiveValue value vm = nextArrayId = environment.nextArrayId + 1 + ( stackItems, newVm ) = + Array.foldl + (\value_ ( accList, accVm ) -> + let + ( stackValue, newAccVm ) = + toStackPrimitiveValue value_ accVm + in + ( stackValue :: accList, newAccVm ) + ) + ( [], vm ) + items + newArray = - { items = items, origin = origin, id = Just nextArrayId } + { items = Array.fromList stackItems + , origin = origin + , id = Just nextArrayId + } newArrays = Dict.insert environment.nextArrayId newArray environment.arrays @@ -313,7 +349,7 @@ toStackPrimitiveValue value vm = , arrays = newArrays } in - ( Stack.ArrayId vm.environment.nextArrayId, { vm | environment = newEnvironment } ) + ( Stack.ArrayId vm.environment.nextArrayId, { newVm | environment = newEnvironment } ) Just id_ -> ( Stack.ArrayId id_, vm )