[WIP] Make macros callable

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

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
     }

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

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