diff --git a/app/elm/Environment.elm b/app/elm/Environment.elm index 19ed820..bde9348 100644 --- a/app/elm/Environment.elm +++ b/app/elm/Environment.elm @@ -1,5 +1,6 @@ module Environment exposing - ( Environment + ( Arrays + , Environment , Object(..) , back , clean @@ -39,6 +40,10 @@ 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 ) @@ -46,7 +51,7 @@ type alias Environment = , penSize : Int , color : Color , nextId : Int - , arrays : Dict Int { items : Array Type.Value, origin : Int, id : Maybe Int } + , arrays : Arrays , nextArrayId : Int } diff --git a/app/elm/Vm/Stack.elm b/app/elm/Vm/Stack.elm index ed44ecc..3461121 100644 --- a/app/elm/Vm/Stack.elm +++ b/app/elm/Vm/Stack.elm @@ -2,53 +2,38 @@ module Vm.Stack exposing ( PrimitiveValue(..) , Stack , Value(..) - , toTypeValue , toValue ) +import Dict +import Environment exposing (Arrays) import Json.Encode as E import Vm.Type as Type {-| This module mainly holds the definition for a `Value` as it is represented on the stack. - -The introduction of arrays that are treated as references by UCBLogo poses a -few challenges as the stack did not have to deal with reference values so far. -This can be seen by the fact that there are now two different types, -`PrimitiveValue` and `Value`, used to represent values on the stack. At this -point, they are not clearly separated yet as `PrimitiveValue`, through its -variant `List`, can hold arrays, and thus reference values. This also leads to -certain programs’s behaviour diverging from their behaviour when run in -UCBLogo. - -As of February 2024, I think a correct and simple solution would be to -integrate `ArrayId` into `PrimitiveValue` and convert `PrimitiveValue` to -`Type.Value` whenever a value is taken from the stack (and vice versa when it -is put onto the stack). Since this would come at a performance cost, I’m -slightly hesitant to adopt this solution. - -} type PrimitiveValue = Word String | Int Int | Float Float - | List (List Type.Value) + | List (List PrimitiveValue) + | ArrayId Int type Value = Void | Address Int | Value PrimitiveValue - | ArrayId Int type alias Stack = List Value -encodeValue : Value -> E.Value -encodeValue value = +encodeValue : Arrays -> Value -> E.Value +encodeValue arrays value = case value of Void -> E.string "_" @@ -56,15 +41,12 @@ encodeValue value = Address address -> E.string <| "@" ++ String.fromInt address - Value value_ -> - E.string <| Type.toDebugString <| toTypeValue value_ - - ArrayId id -> - E.string <| "array @" ++ String.fromInt id + Value primitive -> + E.string <| Type.toDebugString <| toTypeValue arrays primitive -toTypeValue : PrimitiveValue -> Type.Value -toTypeValue value = +toTypeValue : Arrays -> PrimitiveValue -> Type.Value +toTypeValue arrays value = case value of Word string -> Type.Word string @@ -76,9 +58,14 @@ toTypeValue value = Type.Float float List list -> - Type.List list + Type.List (List.map (toTypeValue arrays) list) + + ArrayId id -> + Dict.get id arrays + |> Maybe.map Type.Array + |> Maybe.withDefault (Type.Word "") -toValue : Stack -> E.Value -toValue = - E.list encodeValue +toValue : Arrays -> Stack -> E.Value +toValue arrays = + E.list (encodeValue arrays) diff --git a/app/elm/Vm/Vm.elm b/app/elm/Vm/Vm.elm index 98efda6..a588b24 100644 --- a/app/elm/Vm/Vm.elm +++ b/app/elm/Vm/Vm.elm @@ -216,7 +216,7 @@ toValue { instructions, programCounter, stack, scopes, environment } = E.object [ ( "instructions", encodeInstructions instructions ) , ( "programCounter", E.int programCounter ) - , ( "stack", Stack.toValue stack ) + , ( "stack", Stack.toValue environment.arrays stack ) , ( "scopes", E.list Scope.toValue scopes ) , ( "environment", Environment.toValue environment ) ] @@ -229,23 +229,67 @@ incrementProgramCounter vm = { vm | programCounter = vm.programCounter + 1 } -{-| Convert a `Type.Value` to a `Stack.Value`. If the value is a `Type.Array`, -assign it an id and store it in the VM’s enviromnent. +{-| Convert a `Stack.PrimitiveValue` to a `Type.Value`. If the value is a +`Stack.ArrayId`, use the VM’s enviromnent to resolve it to an array. -} -toStackValue : Type.Value -> Vm -> ( Stack.Value, Vm ) -toStackValue value vm = +toTypeValue : Stack.PrimitiveValue -> Vm -> Result Error Type.Value +toTypeValue value vm = + case value of + Stack.Word string -> + Ok <| Type.Word string + + Stack.Int int -> + Ok <| Type.Int int + + Stack.Float float -> + Ok <| Type.Float float + + Stack.List list -> + let + list_ = + List.foldl + (\value_ acc -> Result.map2 (::) (toTypeValue value_ vm) acc) + (Ok []) + list + in + Result.map Type.List list_ + + Stack.ArrayId id -> + Dict.get id vm.environment.arrays + |> Result.fromMaybe (Internal ArrayNotFound) + |> Result.map Type.Array + + +{-| Convert a `Type.Value` to a `Stack.PrimitiveValue`. If the value is a +`Type.Array`, assign it an id and store it in the VM’s enviromnent. +-} +toStackPrimitiveValue : Type.Value -> Vm -> ( Stack.PrimitiveValue, Vm ) +toStackPrimitiveValue value vm = case value of Type.Word word -> - ( Stack.Value (Stack.Word word), vm ) + ( Stack.Word word, vm ) Type.Int int -> - ( Stack.Value (Stack.Int int), vm ) + ( Stack.Int int, vm ) Type.Float float -> - ( Stack.Value (Stack.Float float), vm ) + ( Stack.Float float, vm ) Type.List list -> - ( Stack.Value (Stack.List list), vm ) + let + ( stackList, newVm ) = + List.foldl + (\value_ ( accList, accVm ) -> + let + ( stackValue, newAccVm ) = + toStackPrimitiveValue value_ accVm + in + ( stackValue :: accList, newAccVm ) + ) + ( [], vm ) + list + in + ( Stack.List stackList, newVm ) Type.Array { items, origin, id } -> case id of @@ -281,9 +325,9 @@ pushValue1 : Type.Value -> Vm -> Vm pushValue1 value vm = let ( newValue, newVm ) = - toStackValue value vm + toStackPrimitiveValue value vm in - { newVm | stack = newValue :: newVm.stack } + { newVm | stack = Stack.Value newValue :: newVm.stack } {-| Pop a single value from the stack. Return a value and the remaining stack. @@ -295,15 +339,8 @@ popValue1 : Vm -> Result Error ( Type.Value, Vm ) popValue1 vm = case vm.stack of (Stack.Value first) :: rest -> - Ok ( Stack.toTypeValue first, { vm | stack = rest } ) - - (Stack.ArrayId id) :: rest -> - case Dict.get id vm.environment.arrays of - Just array -> - Ok ( Type.Array array, { vm | stack = rest } ) - - _ -> - Err <| Internal ArrayNotFound + toTypeValue first vm + |> Result.map (\value -> ( value, { vm | stack = rest } )) _ -> Err <| Internal InvalidStack @@ -390,12 +427,7 @@ popValues n vm = (\value -> case value of Stack.Value value_ -> - Ok (Stack.toTypeValue value_) - - Stack.ArrayId id -> - Dict.get id vm.environment.arrays - |> Result.fromMaybe (Internal ArrayNotFound) - |> Result.map Type.Array + toTypeValue value_ vm _ -> Err <| Internal InvalidStack diff --git a/tests/Test/Encode.elm b/tests/Test/Encode.elm index 9157988..ed6264d 100644 --- a/tests/Test/Encode.elm +++ b/tests/Test/Encode.elm @@ -6,6 +6,7 @@ module Test.Encode exposing , encodeAndDecodeVms ) +import Dict import Environment.History exposing (Entry(..)) import Expect import Json.Decode as D @@ -127,11 +128,11 @@ encodeAndDecodeStack = [ Stack.Void , Stack.Address 10 , Stack.Value <| Stack.Word "word" - , Stack.Value <| Stack.List [ word, Type.List [ word ] ] + , Stack.Value <| Stack.List [ Stack.Word "word", Stack.List [ Stack.Word "word" ] ] ] value = - Stack.toValue stack + Stack.toValue Dict.empty stack in D.decodeValue (D.list D.string) value |> Expect.ok