Parse and compile macro calls

app/elm/Compiler/Ast.elm

@@ -101,7 +101,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
@@ -221,7 +222,10 @@ typeOfCallee node =
         Introspect1 i _ ->
             Primitive { name = i.name }
 
-        Call name _ ->
+        CallFunction name _ ->
+            UserDefinedFunction { name = name }
+
+        CallMacro name _ ->
             UserDefinedFunction { name = name }
 
         Make _ _ ->
@@ -792,7 +796,7 @@ compile context node =
             ]
                 |> List.concat
 
-        Call name arguments ->
+        CallFunction name arguments ->
             let
                 mangledName =
                     mangleName name (List.length arguments)
@@ -803,6 +807,28 @@ compile context node =
             ]
                 |> List.concat
 
+        CallMacro name arguments ->
+            let
+                instructionContext =
+                    toInstructionContext context
+
+                epilogue =
+                    case context of
+                        Statement ->
+                            [ PushVoid ]
+
+                        Expression _ ->
+                            []
+            in
+            [ List.reverse arguments
+                |> List.concatMap (compileInContext (Expression { caller = name }))
+            , [ Instruction.CallByName name
+              , EvalInContext instructionContext
+              ]
+            , epilogue
+            ]
+                |> 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,12 +11,13 @@ type alias LinkedProgram =
     { instructions : List Instruction
     , functionTable : Dict String Int
     , compiledFunctions : List CompiledFunction
+    , compiledMacros : List CompiledMacro
     , startAddress : Int
     }
 
 
-linkProgram : List CompiledFunction -> CompiledProgram -> LinkedProgram
-linkProgram existingCompiledFunctions program =
+linkProgram : List CompiledFunction -> List CompiledMacro -> CompiledProgram -> LinkedProgram
+linkProgram existingCompiledFunctions existingCompiledMacros program =
     let
         compiledFunctions =
             program.compiledFunctions
@@ -25,7 +26,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 +36,36 @@ linkProgram existingCompiledFunctions program =
                 ( Dict.empty, 0 )
                 compiledFunctionInstances
 
+        compiledMacros =
+            program.compiledMacros
+                |> List.append existingCompiledMacros
+
+        ( 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
     }
 
 
@@ -151,9 +153,11 @@ defineFunction state newFunction =
         newFunctions =
             Dict.insert newFunction.name newFunction state.newFunctions
 
-        -- `temporaryState` never leaves this function. It is only used while
-        -- the function body is parsed to enable parsing of recursive
-        -- functions.
+        {- `temporaryState` never leaves this function. It is only used while
+           the function body is parsed to enable parsing of recursive
+           functions. It also sets `inFunction` to `True` which enables parsing
+           of `output` (which is an error outside a function or macro).
+        -}
         temporaryState =
             { state
                 | newFunctions = newFunctions
@@ -271,7 +275,22 @@ 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 +387,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 +539,8 @@ functionCall_ state name =
         functions =
             { newFunctions = state.newFunctions
             , existingFunctions = state.existingFunctions
+            , newMacros = state.newMacros
+            , existingMacros = state.existingMacros
             }
     in
     Callable.find functions name
@@ -619,6 +640,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,28 @@ 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
+        succeed <| Ast.Raise (Exception.TooManyInputs macro.name)
+
+
 name : Callable -> String
 name callable =
     case callable of
@@ -179,15 +221,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 +253,21 @@ 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 +289,9 @@ numberOfDefaultArguments callable =
 
         ExistingFunction function ->
             List.length function.requiredArguments
+
+        NewMacro macro ->
+            List.length macro.arguments
+
+        ExistingMacro macro ->
+            List.length macro.arguments

app/elm/Logo.elm

@@ -74,9 +74,12 @@ compile program logo =
                 |> Result.mapError ParseError
                 |> Result.map (Ast.compileProgram Statement)
 
+        linkProgram =
+            Linker.linkProgram vm.compiledFunctions vm.compiledMacros
+
         result =
             compiledProgram
-                |> Result.map (Linker.linkProgram vm.compiledFunctions)
+                |> Result.map linkProgram
                 |> Result.map Vm.initialize
                 |> Result.map (Vm.withEnvironment vm.environment)
     in