Always store arrays as ids on the stack

Resolve arrays using the VM’s environment whenever they are pushed to or popped from the stack.
cruessler · Feb 6, 2024 · 8786cd8 · 8786cd8
1 parent 29c9a88
commit 8786cd8
Show file tree

Hide file tree

Showing 3 changed files with 60 additions and 14 deletions.
diff --git 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
@@ -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 "<array not found>")
 

diff --git 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 )