Parse macro definitions as part of a program

app/elm/Compiler/Ast.elm

@@ -1,5 +1,6 @@
 module Compiler.Ast exposing
     ( CompiledFunction
+    , CompiledMacro
     , CompiledProgram
     , Context(..)
     , Function
@@ -26,6 +27,7 @@ import Vm.Type as Type
 
 type alias Program =
     { functions : List Function
+    , macros : List Macro
     , body : List Node
     }
 
@@ -35,6 +37,7 @@ type alias Program =
 type alias CompiledProgram =
     { instructions : List Instruction
     , compiledFunctions : List CompiledFunction
+    , compiledMacros : List CompiledMacro
     }
 
 
@@ -48,7 +51,7 @@ type alias Function =
 
 type alias Macro =
     { name : String
-    , requiredArguments : List String
+    , arguments : List String
     , body : List Node
     }
 
@@ -69,6 +72,15 @@ type alias CompiledFunctionInstance =
     }
 
 
+{-| Represent a compiled macro.
+-}
+type alias CompiledMacro =
+    { name : String
+    , arguments : List String
+    , body : List Instruction
+    }
+
+
 type Node
     = Sequence (List Node) Node
     | Repeat Node (List Node)
@@ -846,16 +858,20 @@ compile context node =
 
 
 compileProgram : Program -> CompiledProgram
-compileProgram { functions, body } =
+compileProgram { functions, macros, body } =
     let
         compiledFunctions =
             List.map compileFunction functions
 
+        compiledMacros =
+            List.map compileMacro macros
+
         instructions =
             List.concatMap (compileInContext Statement) body
     in
     { instructions = instructions
     , compiledFunctions = compiledFunctions
+    , compiledMacros = compiledMacros
     }
 
 
@@ -959,3 +975,35 @@ compileFunction ({ name, requiredArguments, optionalArguments } as function) =
     , optionalArguments = List.map Tuple.first optionalArguments
     , instances = compileFunctionInstances function
     }
+
+
+{-| Compile a macro.
+-}
+compileMacro : Macro -> CompiledMacro
+compileMacro { name, arguments, body } =
+    let
+        instructionsForArguments =
+            [ [ PushLocalScope ]
+            , List.concatMap compileRequiredArgument arguments
+            ]
+                |> List.concat
+
+        instructionsForBody =
+            [ List.concatMap (compileInContext Statement) body
+            , [ PushVoid
+              , PopLocalScope
+              , Instruction.Return
+              ]
+            ]
+                |> List.concat
+
+        compiledBody =
+            [ instructionsForArguments
+            , instructionsForBody
+            ]
+                |> List.concat
+    in
+    { name = name
+    , arguments = arguments
+    , body = compiledBody
+    }

app/elm/Compiler/Parser.elm

@@ -17,7 +17,7 @@ module Compiler.Parser exposing
 -}
 
 import Char
-import Compiler.Ast as Ast exposing (CompiledFunction)
+import Compiler.Ast as Ast exposing (CompiledFunction, CompiledMacro)
 import Compiler.Ast.Introspect as Introspect
 import Compiler.Parser.Callable as Callable
 import Compiler.Parser.Context exposing (Context(..))
@@ -48,6 +48,8 @@ type alias Error =
 type alias State =
     { newFunctions : Dict String Ast.Function
     , existingFunctions : Dict String CompiledFunction
+    , newMacros : Dict String Ast.Macro
+    , existingMacros : Dict String CompiledMacro
     , parsedBody : List Ast.Node
     , inFunction : Bool
     }
@@ -57,6 +59,8 @@ defaultState : State
 defaultState =
     { newFunctions = Dict.empty
     , existingFunctions = Dict.empty
+    , newMacros = Dict.empty
+    , existingMacros = Dict.empty
     , parsedBody = []
     , inFunction = False
     }
@@ -77,6 +81,7 @@ toplevel state =
     let
         program =
             { functions = Dict.values state.newFunctions
+            , macros = Dict.values state.newMacros
             , body = state.parsedBody
             }
     in
@@ -95,6 +100,7 @@ toplevel_ state =
         |. Helper.maybeSpaces
         |= P.oneOf
             [ function state
+            , macro state
             , toplevelStatements state
             , P.succeed state
             ]
@@ -236,6 +242,33 @@ functionBody_ state acc =
         ]
 
 
+defineMacroUnlessDefined : State -> Ast.Macro -> State
+defineMacroUnlessDefined state newMacro =
+    if
+        Dict.member newMacro.name state.newMacros
+            || Dict.member newMacro.name state.existingMacros
+    then
+        let
+            parsedBody =
+                state.parsedBody
+                    ++ [ Ast.Raise (Exception.MacroAlreadyDefined newMacro.name) ]
+        in
+        { state | parsedBody = parsedBody }
+
+    else
+        let
+            newMacros =
+                Dict.insert newMacro.name newMacro state.newMacros
+        in
+        { state | newMacros = newMacros }
+
+
+macro : State -> Parser State
+macro state =
+    macroDefinition state
+        |> P.map (defineMacroUnlessDefined state)
+
+
 defineMacro : State -> Ast.Macro -> Parser Ast.Macro
 defineMacro state newMacro =
     functionBody state

app/elm/Vm/Error.elm

@@ -34,6 +34,7 @@ type Error
     | NotEnoughInputs String
     | TooManyInputs String
     | FunctionAlreadyDefined String
+    | MacroAlreadyDefined String
     | CallableUndefined String
 
 
@@ -64,6 +65,9 @@ toString error =
         FunctionAlreadyDefined functionName ->
             functionName ++ " is already defined"
 
+        MacroAlreadyDefined macroName ->
+            macroName ++ " is already defined"
+
         CallableUndefined functionName ->
             "I don’t know how to " ++ functionName
 

app/elm/Vm/Exception.elm

@@ -9,4 +9,5 @@ type Exception
     | NotEnoughInputs String
     | TooManyInputs String
     | FunctionAlreadyDefined String
+    | MacroAlreadyDefined String
     | CallableUndefined String

app/elm/Vm/Vm.elm

@@ -1058,6 +1058,9 @@ raise exception vm =
         Exception.FunctionAlreadyDefined functionName ->
             Err <| FunctionAlreadyDefined functionName
 
+        Exception.MacroAlreadyDefined macroName ->
+            Err <| MacroAlreadyDefined macroName
+
         Exception.CallableUndefined functionName ->
             Err <| CallableUndefined functionName
 

tests/Test/Parser.elm

@@ -131,18 +131,18 @@ parsesMacro source macro =
 macroDefinition : Test
 macroDefinition =
     describe "define a macro" <|
-        [ test "with mandatory arguments and no body" <|
+        [ test "with arguments and no body" <|
             \_ ->
                 parsesMacro ".macro foo :bar :baz\nend\n"
                     { name = "foo"
-                    , requiredArguments = [ "bar", "baz" ]
+                    , arguments = [ "bar", "baz" ]
                     , body = []
                     }
-        , test "with mandatory argument and body" <|
+        , test "with argument and body" <|
             \_ ->
                 parsesMacro ".macro foo :bar\nprint :bar\nend\n"
                     { name = "foo"
-                    , requiredArguments = [ "bar" ]
+                    , arguments = [ "bar" ]
                     , body =
                         [ Ast.CommandN
                             { name = "print", f = C.printN, numberOfDefaultArguments = 1 }
@@ -153,7 +153,7 @@ macroDefinition =
             \_ ->
                 parsesMacro ".macro foo\nend\n"
                     { name = "foo"
-                    , requiredArguments = []
+                    , arguments = []
                     , body = []
                     }
         ]

tests/Test/Run.elm

@@ -231,6 +231,18 @@ end
         ]
 
 
+macroDefinition : Test
+macroDefinition =
+    describe "define macro" <|
+        [ printsLines
+            """.macro foo :bar
+output lput (word "" :bar) [print]
+end
+"""
+            []
+        ]
+
+
 parenthesesIndicatingPreference : Test
 parenthesesIndicatingPreference =
     describe "parentheses can indicate preference" <|