diff --git a/app/elm/Compiler/Ast.elm b/app/elm/Compiler/Ast.elm index 52e2f31..039013c 100644 --- a/app/elm/Compiler/Ast.elm +++ b/app/elm/Compiler/Ast.elm @@ -83,8 +83,8 @@ type Node | Call String (List Node) | Return (Maybe Node) | Run Node - | Make String Node - | Local String + | Make Node Node + | Localmake Node Node | Variable String | Value Type.Value | Raise Exception @@ -202,6 +202,9 @@ typeOfCallee node = Make _ _ -> Command { name = "make" } + Localmake _ _ -> + Command { name = "localmake" } + Variable name -> Primitive { name = name } @@ -223,9 +226,6 @@ typeOfCallee node = Raise _ -> DoesNotApply - Local _ -> - DoesNotApply - {-| Compile a non-empty branch of a control structure, e. g. of an `if`, to a list of VM instructions. @@ -758,14 +758,33 @@ compile context node = ] |> List.concat - Make name node_ -> - [ compileInContext (Expression { caller = "make" }) node_ - , [ StoreVariable name ] + Make name value -> + let + compiledValue = + compileInContext (Expression { caller = "make" }) value + + compiledName = + compileInContext (Expression { caller = "make" }) name + in + [ compiledValue + , compiledName + , [ Instruction.Make ] ] |> List.concat - Local name -> - [ LocalVariable name ] + Localmake name value -> + let + compiledValue = + compileInContext (Expression { caller = "localmake" }) value + + compiledName = + compileInContext (Expression { caller = "localmake" }) name + in + [ compiledValue + , compiledName + , [ Instruction.Localmake ] + ] + |> List.concat Variable name -> [ PushVariable name ] diff --git a/app/elm/Compiler/Parser.elm b/app/elm/Compiler/Parser.elm index 28371a3..2699554 100644 --- a/app/elm/Compiler/Parser.elm +++ b/app/elm/Compiler/Parser.elm @@ -680,47 +680,25 @@ templateVariable = localmake : State -> Parser Ast.Node localmake state = - let - makeNode : ( Type.Value, Ast.Node ) -> Parser Ast.Node - makeNode ( name, node ) = - case name of - Type.Word word -> - P.succeed <| Ast.Sequence [ Ast.Local word ] (Ast.Make word node) - - _ -> - P.problem ExpectingWord - in P.inContext Localmake <| - (P.succeed (\a b -> ( a, b )) + (P.succeed Ast.Localmake |. Helper.keyword "localmake" |. Helper.spaces - |= Value.wordOutsideList + |= booleanExpression state |. Helper.spaces |= booleanExpression state - |> P.andThen makeNode ) make : State -> Parser Ast.Node make state = - let - makeNode : ( Type.Value, Ast.Node ) -> Parser Ast.Node - makeNode ( name, node ) = - case name of - Type.Word word -> - P.succeed <| Ast.Make word node - - _ -> - P.problem ExpectingWord - in P.inContext Make <| - (P.succeed (\a b -> ( a, b )) + (P.succeed Ast.Make |. Helper.keyword "make" |. Helper.spaces - |= Value.wordOutsideList + |= booleanExpression state |. Helper.spaces |= booleanExpression state - |> P.andThen makeNode ) diff --git a/app/elm/Vm/Instruction.elm b/app/elm/Vm/Instruction.elm index 6c8f4e0..4e5da56 100644 --- a/app/elm/Vm/Instruction.elm +++ b/app/elm/Vm/Instruction.elm @@ -14,6 +14,8 @@ type Instruction | PushVariable String | StoreVariable String | LocalVariable String + | Make + | Localmake | Introspect0 I.Introspect0 | Introspect1 I.Introspect1 | Eval diff --git a/app/elm/Vm/Type.elm b/app/elm/Vm/Type.elm index b4e02bf..7907010 100644 --- a/app/elm/Vm/Type.elm +++ b/app/elm/Vm/Type.elm @@ -10,6 +10,7 @@ module Vm.Type exposing , toFloat , toInt , toString + , toWord , true ) @@ -45,7 +46,8 @@ type Value type Error - = NoInt String + = NoWord String + | NoInt String | NoFloat String | NoBool String @@ -117,6 +119,25 @@ toDebugString value = toString value +{-| Unwrap `Value` if it is a word or any of its optimized variants that can be +treated as a word. +-} +toWord : Value -> Result Error String +toWord value = + case value of + Word word -> + Ok word + + Int int -> + Ok (String.fromInt int) + + Float float -> + Ok (String.fromFloat float) + + _ -> + Err <| NoWord (toString value) + + {-| Parse `Value` as an integer. -} toInt : Value -> Result Error Int diff --git a/app/elm/Vm/Vm.elm b/app/elm/Vm/Vm.elm index 014809a..cf3475a 100644 --- a/app/elm/Vm/Vm.elm +++ b/app/elm/Vm/Vm.elm @@ -113,6 +113,12 @@ encodeInstruction instruction = LocalVariable name -> "LocalVariable " ++ name + Make -> + "Make" + + Localmake -> + "Localmake" + Introspect0 { name } -> "Introspect0 " ++ name @@ -768,6 +774,44 @@ localVariable name vm = ) +make : Vm -> Result Error Vm +make vm = + popValue2 vm + |> Result.andThen + (\( name, value, newVm ) -> + name + |> Type.toWord + |> Result.map + (\word -> + { newVm | scopes = Scope.make word value vm.scopes } + |> incrementProgramCounter + ) + |> Result.mapError (\_ -> WrongInput "make" (Type.toDebugString name)) + ) + + +localmake : Vm -> Result Error Vm +localmake vm = + popValue2 vm + |> Result.andThen + (\( name, value, newVm ) -> + name + |> Type.toWord + |> Result.map + (\word -> + let + newScopes = + vm.scopes + |> Scope.local word + |> Scope.make word value + in + { newVm | scopes = newScopes } + |> incrementProgramCounter + ) + |> Result.mapError (\_ -> WrongInput "localmake" (Type.toDebugString name)) + ) + + pushLoopScope : Vm -> Result Error Vm pushLoopScope vm = popValue1 vm @@ -1011,6 +1055,12 @@ execute instruction vm = LocalVariable name -> localVariable name vm + Make -> + make vm + + Localmake -> + localmake vm + Introspect0 primitive -> introspect0 primitive vm diff --git a/tests/Test/Error.elm b/tests/Test/Error.elm index 44405f2..dbb8dad 100644 --- a/tests/Test/Error.elm +++ b/tests/Test/Error.elm @@ -69,6 +69,8 @@ functionsWithInvalidArguments = , printsError "print quotient 1 []" "quotient doesn’t like [] as input" , printsError "print minus []" "minus doesn’t like [] as input" , printsError "print fput \"wo \"rd" "fput doesn’t like wo as input" + , printsError "make [] 1" "make doesn’t like [] as input" + , printsError "localmake [] 1" "localmake doesn’t like [] as input" ] diff --git a/tests/Test/Run/Builtin.elm b/tests/Test/Run/Builtin.elm index a7e5206..483cf11 100644 --- a/tests/Test/Run/Builtin.elm +++ b/tests/Test/Run/Builtin.elm @@ -1,4 +1,4 @@ -module Test.Run.Builtin exposing (commands, primitives, print, show) +module Test.Run.Builtin exposing (commands, make, primitives, print, show) import Test exposing (Test, describe) import Test.Helper exposing (printsLine, runsWithoutError) @@ -166,3 +166,12 @@ show = , printsLine "show sentence 1 1" "[1 1]" , printsLine "show (array 2 10)" "{[] []}" ] + + +make : Test +make = + describe "make" <| + [ printsLine "make 1 [a b c] print :1" "a b c" + , printsLine "make 1.1 1 print :1.1" "1" + , printsLine "make 1.1 1 make :1.1 2 print :1" "2" + ]