[WIP] Add setitem

cruessler · Feb 10, 2024 · 94e0714 · 94e0714
1 parent cc5e75e
commit 94e0714
Show file tree

Hide file tree

Showing 5 changed files with 137 additions and 2 deletions.
diff --git a/app/elm/Compiler/Ast.elm b/app/elm/Compiler/Ast.elm
@@ -88,6 +88,7 @@ type Node
     | Localmake Node Node
     | Thing Node
     | Variable String
+    | Setitem Node Node Node
     | Value Type.Value
     | Raise Exception
 
@@ -216,6 +217,9 @@ typeOfCallee node =
         Variable name ->
             Primitive { name = name }
 
+        Setitem _ _ _ ->
+            Command { name = "setitem" }
+
         Value _ ->
             Primitive { name = "value" }
 
@@ -830,6 +834,24 @@ compile context node =
         Variable name ->
             [ PushVariable name ]
 
+        Setitem index array value ->
+            let
+                compiledValue =
+                    compileInContext (Expression { caller = "setitem" }) value
+
+                compiledArray =
+                    compileInContext (Expression { caller = "setitem" }) array
+
+                compiledIndex =
+                    compileInContext (Expression { caller = "setitem" }) index
+            in
+            [ compiledValue
+            , compiledArray
+            , compiledIndex
+            , [ Instruction.Setitem ]
+            ]
+                |> List.concat
+
         Value value ->
             [ PushValue value ]
 

diff --git a/app/elm/Compiler/Parser.elm b/app/elm/Compiler/Parser.elm
@@ -7,6 +7,7 @@ module Compiler.Parser exposing
     , defaultState
     , functionDefinition
     , output
+    , setitem
     , statement
     , term
     , withExistingFunctions
@@ -294,6 +295,7 @@ statement state =
             , templateVariable
             , thing state
             , variable
+            , setitem state
             , P.lazy (\_ -> functionCall state)
             , Value.value
             ]
@@ -757,3 +759,17 @@ variable =
                                 && (c /= '>')
                         )
                )
+
+
+setitem : State -> Parser Ast.Node
+setitem state =
+    P.inContext Make <|
+        (P.succeed Ast.Setitem
+            |. Helper.keyword "setitem"
+            |. Helper.spaces
+            |= booleanExpression state
+            |. Helper.spaces
+            |= booleanExpression state
+            |. Helper.spaces
+            |= booleanExpression state
+        )
diff --git a/app/elm/Vm/Instruction.elm b/app/elm/Vm/Instruction.elm
@@ -17,6 +17,7 @@ type Instruction
     | Make
     | Localmake
     | Thing
+    | Setitem
     | Introspect0 I.Introspect0
     | Introspect1 I.Introspect1
     | Eval

diff --git a/app/elm/Vm/Vm.elm b/app/elm/Vm/Vm.elm
@@ -122,6 +122,9 @@ encodeInstruction instruction =
                 Thing ->
                     "Thing"
 
+                Setitem ->
+                    "Setitem"
+
                 Introspect0 { name } ->
                     "Introspect0 " ++ name
 
@@ -839,6 +842,86 @@ thing vm =
             )
 
 
+setitem : Vm -> Result Error Vm
+setitem vm =
+    popValue3 vm
+        |> Result.andThen
+            (\result ->
+                let
+                    index : Result Error Int
+                    index =
+                        Type.toInt result.first
+                            |> Result.mapError (\_ -> WrongInput "setitem" (Type.toDebugString result.first))
+
+                    array : Result Error { items : Array Type.Value, origin : Int, id : Maybe Int }
+                    array =
+                        case result.second of
+                            Type.Array array_ ->
+                                Ok array_
+
+                            _ ->
+                                Err <| Error.WrongInput "setitem" (Type.toDebugString result.second)
+
+                    arrayId : Result Error Int
+                    arrayId =
+                        Result.andThen (\{ id } -> Result.fromMaybe (Internal Error.ArrayNotFound) id) array
+
+                    newItems : Result Error ( List Stack.Value, Vm )
+                    newItems =
+                        Result.map2
+                            (\index_ { items, origin } ->
+                                items
+                                    |> Array.set (index_ - origin) result.third
+                                    |> Array.foldl
+                                        (\value_ ( accList, accVm ) ->
+                                            let
+                                                ( stackValue, newAccVm ) =
+                                                    toStackValue value_ accVm
+                                            in
+                                            ( stackValue :: accList, newAccVm )
+                                        )
+                                        ( [], vm )
+                            )
+                            index
+                            array
+
+                    newArray : Result Error ( { items : Array Stack.Value, origin : Int, id : Maybe Int }, Vm )
+                    newArray =
+                        Result.map2
+                            (\( items, vm_ ) { origin, id } ->
+                                ( { items = Array.fromList items
+                                  , origin = origin
+                                  , id = id
+                                  }
+                                , vm_
+                                )
+                            )
+                            newItems
+                            array
+
+                    newVm : Result Error Vm
+                    newVm =
+                        Result.map2
+                            (\id ( array_, vm_ ) ->
+                                let
+                                    newArrays =
+                                        Dict.insert id array_ vm_.environment.arrays
+
+                                    environment =
+                                        vm_.environment
+
+                                    newEnvironment =
+                                        { environment | arrays = newArrays }
+                                in
+                                { vm_ | environment = newEnvironment }
+                            )
+                            arrayId
+                            newArray
+                in
+                Result.map incrementProgramCounter newVm
+            )
+
+
 pushLoopScope : Vm -> Result Error Vm
 pushLoopScope vm =
     popValue1 vm
@@ -1091,6 +1174,9 @@ execute instruction vm =
         Thing ->
             thing vm
 
+        Setitem ->
+            setitem vm
+
         Introspect0 primitive ->
             introspect0 primitive vm
 

diff --git a/tests/Test/Run/Builtin.elm b/tests/Test/Run/Builtin.elm
@@ -1,7 +1,7 @@
-module Test.Run.Builtin exposing (commands, make, primitives, print, show, thing)
+module Test.Run.Builtin exposing (commands, make, primitives, print, setitem, show, thing)
 
 import Test exposing (Test, describe)
-import Test.Helper exposing (printsLine, runsWithoutError)
+import Test.Helper exposing (printsLine, printsLines, runsWithoutError)
 
 
 commands : Test
@@ -190,3 +190,13 @@ thing =
         , printsLine "make \"a \"word make \"b \"a print thing :b" "word"
         , printsLine "make \"a \"word make \"b \"a print thing thing \"b" "word"
         ]
+
+
+setitem : Test
+setitem =
+    describe "setitem" <|
+        [ printsLines "make \"a (array 2) print :a setitem 1 :a \"b print :a"
+            [ "{[] []}"
+            , "{b []}"
+            ]
+        ]