From 98c67a2da742b05c323f01f1d17f0754f2c05cd8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Christoph=20R=C3=BC=C3=9Fler?= Date: Sun, 18 Feb 2024 16:00:24 +0100 Subject: [PATCH] [WIP] Make macros callable --- app/elm/Compiler/Ast.elm | 28 +++++++++-- app/elm/Compiler/Linker.elm | 42 +++++++++++++--- app/elm/Compiler/Parser.elm | 27 +++++++++-- app/elm/Compiler/Parser/Callable.elm | 72 ++++++++++++++++++++++++++-- app/elm/Vm/Vm.elm | 18 ++++++- tests/Test/Run.elm | 3 +- 6 files changed, 171 insertions(+), 19 deletions(-) diff --git a/app/elm/Compiler/Ast.elm b/app/elm/Compiler/Ast.elm index 6400c60..2fadc85 100644 --- a/app/elm/Compiler/Ast.elm +++ b/app/elm/Compiler/Ast.elm @@ -15,6 +15,7 @@ module Compiler.Ast exposing {-| This module provides types and functions for working with Logo ASTs. -} +import Compiler.Ast.Command exposing (name) import List.Nonempty exposing (Nonempty(..)) import Vm.Command as C import Vm.Error exposing (Error(..)) @@ -101,7 +102,8 @@ type Node | PrimitiveN P.PrimitiveN (List Node) | Introspect0 I.Introspect0 | Introspect1 I.Introspect1 Node - | Call String (List Node) + | CallFunction String (List Node) + | CallMacro String (List Node) | Return (Maybe Node) | Run Node | Make Node Node @@ -158,6 +160,12 @@ branches not necessarily have the same type. type Callee = Primitive { name : String } | Command { name : String } + -- TODO + -- do we need an additional variant for internal functions that only + -- sometimes return a value, like `run`? + -- adding extra behaviour for `run` could be done on `main` and would + -- hopefully not have to be implemented on `add-macros` + -- are changes needed for macros? | UserDefinedFunction { name : String } | DoesNotApply @@ -221,7 +229,12 @@ typeOfCallee node = Introspect1 i _ -> Primitive { name = i.name } - Call name _ -> + CallFunction name _ -> + UserDefinedFunction { name = name } + + CallMacro name _ -> + -- TODO + -- check whether a separate variant is necessary UserDefinedFunction { name = name } Make _ _ -> @@ -782,7 +795,7 @@ compile context node = ] |> List.concat - Call name arguments -> + CallFunction name arguments -> let mangledName = mangleName name (List.length arguments) @@ -793,6 +806,15 @@ compile context node = ] |> List.concat + CallMacro name arguments -> + [ List.reverse arguments + |> List.concatMap (compileInContext (Expression { caller = name })) + , [ Instruction.CallByName name + , Eval + ] + ] + |> List.concat + Return (Just node_) -> [ compileInContext (Expression { caller = "output" }) node_ , [ PopLocalScope diff --git a/app/elm/Compiler/Linker.elm b/app/elm/Compiler/Linker.elm index 87e510c..98c8bcf 100644 --- a/app/elm/Compiler/Linker.elm +++ b/app/elm/Compiler/Linker.elm @@ -1,6 +1,6 @@ module Compiler.Linker exposing (LinkedProgram, linkProgram) -import Compiler.Ast exposing (CompiledFunction, CompiledProgram) +import Compiler.Ast exposing (CompiledFunction, CompiledMacro, CompiledProgram) import Dict exposing (Dict) import Vm.Instruction exposing (Instruction) @@ -11,10 +11,16 @@ type alias LinkedProgram = { instructions : List Instruction , functionTable : Dict String Int , compiledFunctions : List CompiledFunction + , compiledMacros : List CompiledMacro , startAddress : Int } + +-- TODO +-- do we need to pass `existingCompiledMacros` as well? + + linkProgram : List CompiledFunction -> CompiledProgram -> LinkedProgram linkProgram existingCompiledFunctions program = let @@ -25,7 +31,7 @@ linkProgram existingCompiledFunctions program = compiledFunctionInstances = List.concatMap .instances compiledFunctions - ( functionTable, startAddress ) = + ( functionTable, startAddressAfterFunctions ) = List.foldl (\f ( acc, address ) -> ( Dict.insert f.mangledName address acc @@ -35,13 +41,35 @@ linkProgram existingCompiledFunctions program = ( Dict.empty, 0 ) compiledFunctionInstances + compiledMacros = + program.compiledMacros + + ( macroAndFunctionTable, startAddressAfterMacros ) = + List.foldl + (\m ( acc, address ) -> + ( Dict.insert m.name address acc + , address + List.length m.body + ) + ) + ( functionTable, startAddressAfterFunctions ) + compiledMacros + + instructionsForFunctions = + List.concatMap .body compiledFunctionInstances + + instructionsForMacros = + List.concatMap .body compiledMacros + instructions = - List.append - (List.concatMap .body compiledFunctionInstances) - program.instructions + [ instructionsForFunctions + , instructionsForMacros + , program.instructions + ] + |> List.concat in { instructions = instructions - , functionTable = functionTable + , functionTable = macroAndFunctionTable , compiledFunctions = compiledFunctions - , startAddress = startAddress + , compiledMacros = compiledMacros + , startAddress = startAddressAfterMacros } diff --git a/app/elm/Compiler/Parser.elm b/app/elm/Compiler/Parser.elm index 41556b8..7641629 100644 --- a/app/elm/Compiler/Parser.elm +++ b/app/elm/Compiler/Parser.elm @@ -52,6 +52,7 @@ type alias State = , existingMacros : Dict String CompiledMacro , parsedBody : List Ast.Node , inFunction : Bool + , inMacro : Bool } @@ -63,6 +64,7 @@ defaultState = , existingMacros = Dict.empty , parsedBody = [] , inFunction = False + , inMacro = False } @@ -153,7 +155,8 @@ defineFunction state newFunction = -- `temporaryState` never leaves this function. It is only used while -- the function body is parsed to enable parsing of recursive - -- functions. + -- functions. It also sets `inMacro` to `True` which enables parsing of + -- `output` (which is an error outside a function or macro). temporaryState = { state | newFunctions = newFunctions @@ -271,7 +274,21 @@ macro state = defineMacro : State -> Ast.Macro -> Parser Ast.Macro defineMacro state newMacro = - functionBody state + let + newMacros = + Dict.insert newMacro.name newMacro state.newMacros + + -- `temporaryState` never leaves this function. It is only used while + -- the macro body is parsed to enable parsing of recursive macros. It + -- also sets `inMacro` to `True` which enables parsing of `output` + -- (which is an error outside a function or macro). + temporaryState = + { state + | newMacros = newMacros + , inMacro = True + } + in + functionBody temporaryState |> P.map (\body -> { newMacro | body = body }) @@ -368,7 +385,7 @@ output : State -> Parser Ast.Node output state = let makeNode expr = - if state.inFunction then + if state.inFunction || state.inMacro then Ast.Return <| Just expr else @@ -520,6 +537,8 @@ functionCall_ state name = functions = { newFunctions = state.newFunctions , existingFunctions = state.existingFunctions + , newMacros = state.newMacros + , existingMacros = state.existingMacros } in Callable.find functions name @@ -619,6 +638,8 @@ variableFunctionCall state name arguments_ = functions = { newFunctions = state.newFunctions , existingFunctions = state.existingFunctions + , newMacros = state.newMacros + , existingMacros = state.existingMacros } in Callable.find functions name diff --git a/app/elm/Compiler/Parser/Callable.elm b/app/elm/Compiler/Parser/Callable.elm index f718004..a9cb809 100644 --- a/app/elm/Compiler/Parser/Callable.elm +++ b/app/elm/Compiler/Parser/Callable.elm @@ -1,6 +1,6 @@ module Compiler.Parser.Callable exposing (find, makeNode, numberOfDefaultArguments) -import Compiler.Ast as Ast exposing (CompiledFunction) +import Compiler.Ast as Ast exposing (CompiledFunction, CompiledMacro) import Compiler.Ast.Command as Command import Compiler.Ast.Introspect as Introspect import Compiler.Ast.Primitive as Primitive @@ -16,6 +16,8 @@ type Callable | Primitive Primitive.Primitive | NewFunction Ast.Function | ExistingFunction CompiledFunction + | NewMacro Ast.Macro + | ExistingMacro CompiledMacro type alias Function = @@ -25,6 +27,12 @@ type alias Function = } +type alias Macro = + { name : String + , numberOfArguments : Int + } + + makeNode : List Ast.Node -> Callable -> Parser context Problem Ast.Node makeNode arguments callable = let @@ -92,6 +100,24 @@ makeNode arguments callable = in makeFunction arguments callableFunction + NewMacro macro -> + let + callableMacro = + { name = macro.name + , numberOfArguments = numberOfRequiredArguments + } + in + makeMacro arguments callableMacro + + ExistingMacro macro -> + let + callableMacro = + { name = macro.name + , numberOfArguments = numberOfRequiredArguments + } + in + makeMacro arguments callableMacro + makeCommand : List Ast.Node -> Command.Command -> Parser context Problem Ast.Node makeCommand arguments command = @@ -155,12 +181,30 @@ makeFunction arguments function = <= function.numberOfRequiredArguments + function.numberOfOptionalArguments then - succeed <| Ast.Call function.name arguments + succeed <| Ast.CallFunction function.name arguments else succeed <| Ast.Raise (Exception.TooManyInputs function.name) +makeMacro : List Ast.Node -> Macro -> Parser context Problem Ast.Node +makeMacro arguments macro = + let + numberOfArguments = + List.length arguments + in + if + numberOfArguments + <= macro.numberOfArguments + then + succeed <| Ast.CallMacro macro.name arguments + + else + -- TODO + -- verify that this error is thrown by UCBLogo + succeed <| Ast.Raise (Exception.TooManyInputs macro.name) + + name : Callable -> String name callable = case callable of @@ -179,15 +223,23 @@ name callable = ExistingFunction function -> function.name + NewMacro macro -> + macro.name + + ExistingMacro macro -> + macro.name + type alias Functions = { newFunctions : Dict String Ast.Function , existingFunctions : Dict String CompiledFunction + , newMacros : Dict String Ast.Macro + , existingMacros : Dict String CompiledMacro } find : Functions -> String -> Maybe Callable -find { newFunctions, existingFunctions } name_ = +find { newFunctions, existingFunctions, newMacros, existingMacros } name_ = let command = Command.find name_ |> Maybe.map Command @@ -203,8 +255,14 @@ find { newFunctions, existingFunctions } name_ = existingFunction = Dict.get name_ existingFunctions |> Maybe.map ExistingFunction + + macro = + Dict.get name_ newMacros |> Maybe.map NewMacro + + existingMacro = + Dict.get name_ existingMacros |> Maybe.map ExistingMacro in - [ command, primitive, introspect, function, existingFunction ] + [ command, primitive, introspect, function, existingFunction, macro, existingMacro ] |> List.filterMap identity |> List.head @@ -226,3 +284,9 @@ numberOfDefaultArguments callable = ExistingFunction function -> List.length function.requiredArguments + + NewMacro macro -> + List.length macro.arguments + + ExistingMacro macro -> + List.length macro.arguments diff --git a/app/elm/Vm/Vm.elm b/app/elm/Vm/Vm.elm index bdbc0ac..4aa4510 100644 --- a/app/elm/Vm/Vm.elm +++ b/app/elm/Vm/Vm.elm @@ -42,8 +42,14 @@ type alias Vm = , stack : Stack , scopes : List Scope , environment : Environment + + -- TODO + -- possibly rename to callableTable or functionAndMacroTable? , functionTable : Dict String Int , compiledFunctions : List CompiledFunction + + -- TODO + -- add compiledMacros } @@ -55,6 +61,7 @@ empty = { instructions = [] , functionTable = Dict.empty , compiledFunctions = [] + , compiledMacros = [] , startAddress = 0 } @@ -523,8 +530,17 @@ parseAndEvalInstructions vm instructions = in Ok newVm + -- TODO + -- assumption: `subVm`, at its toplevel, checks for void on the + -- stack + -- since void on the stack is expect in the example I’m + -- debugging, the check succeeds and `Void` is removed [] -> - vm |> withEnvironment subVm.environment |> Ok + let + newVm = + { vm | environment = subVm.environment, stack = Stack.Void :: vm.stack } + in + Ok newVm _ -> Err <| Internal EvalFailed diff --git a/tests/Test/Run.elm b/tests/Test/Run.elm index 776b6d2..cfd00a4 100644 --- a/tests/Test/Run.elm +++ b/tests/Test/Run.elm @@ -238,8 +238,9 @@ macroDefinition = """.macro foo :bar output lput (word "" :bar) [print] end +foo "a """ - [] + [ "a" ] ]