diff --git a/app/elm/Compiler/Ast.elm b/app/elm/Compiler/Ast.elm index 140c449..afc7955 100644 --- a/app/elm/Compiler/Ast.elm +++ b/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 diff --git a/app/elm/Compiler/Linker.elm b/app/elm/Compiler/Linker.elm index 87e510c..7c7b025 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,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 } diff --git a/app/elm/Compiler/Parser.elm b/app/elm/Compiler/Parser.elm index 41556b8..50227bf 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 } @@ -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 diff --git a/app/elm/Compiler/Parser/Callable.elm b/app/elm/Compiler/Parser/Callable.elm index f718004..b2f6b94 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,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 diff --git a/app/elm/Logo.elm b/app/elm/Logo.elm index 7e06b07..474c45b 100644 --- a/app/elm/Logo.elm +++ b/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 diff --git a/app/elm/Vm/Vm.elm b/app/elm/Vm/Vm.elm index 66e4860..518d4d7 100644 --- a/app/elm/Vm/Vm.elm +++ b/app/elm/Vm/Vm.elm @@ -16,7 +16,7 @@ machine as well as functions for running it. -} import Array exposing (Array) -import Compiler.Ast as Ast exposing (CompiledFunction, CompiledProgram, Program) +import Compiler.Ast as Ast exposing (CompiledFunction, CompiledMacro, CompiledProgram, Program) import Compiler.Linker as Linker exposing (LinkedProgram) import Compiler.Parser as Parser exposing (Parser) import Dict exposing (Dict) @@ -45,6 +45,7 @@ type alias Vm = , environment : Environment , functionTable : Dict String Int , compiledFunctions : List CompiledFunction + , compiledMacros : List CompiledMacro } @@ -56,6 +57,7 @@ empty = { instructions = [] , functionTable = Dict.empty , compiledFunctions = [] + , compiledMacros = [] , startAddress = 0 } @@ -63,7 +65,7 @@ empty = {-| Initialize a `Vm` with a list of instructions and a program counter. -} initialize : LinkedProgram -> Vm -initialize { instructions, functionTable, compiledFunctions, startAddress } = +initialize { instructions, functionTable, compiledFunctions, compiledMacros, startAddress } = { instructions = Array.fromList instructions , programCounter = startAddress , executionHaltedDueToError = False @@ -72,6 +74,7 @@ initialize { instructions, functionTable, compiledFunctions, startAddress } = , environment = Environment.empty , functionTable = functionTable , compiledFunctions = compiledFunctions + , compiledMacros = compiledMacros } @@ -529,9 +532,12 @@ parseAndEvalInstructions context vm instructions = |> Type.toString |> parseAndCompileProgram context parser + linkProgram = + Linker.linkProgram vm.compiledFunctions vm.compiledMacros + result = compiledProgram - |> Result.map (Linker.linkProgram vm.compiledFunctions) + |> Result.map linkProgram |> Result.map initialize |> Result.map (withEnvironment vm.environment) |> Result.map run diff --git a/tests/Test/Error.elm b/tests/Test/Error.elm index e81607e..64638a3 100644 --- a/tests/Test/Error.elm +++ b/tests/Test/Error.elm @@ -125,6 +125,11 @@ output "bar end foo "baz""" "You don’t say what to do with bar" + , printsError """.macro m +output [3] +end +m""" + "You don’t say what to do with 3" , printsError "3" "You don’t say what to do with 3" , printsError "repcount" "You don’t say what to do with -1" , printsError "foreach 1 [ 5 ]" "You don’t say what to do with 5" @@ -177,6 +182,12 @@ end (foo "bar "baz)""" "too many inputs to foo" , printsError "(array 1 2 3)" "too many inputs to array" + , printsError + """.macro m +print "a +end +(m "b)""" + "too many inputs to m" ] 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" ] ] diff --git a/tests/Test/Vm.elm b/tests/Test/Vm.elm index 881e930..d90acb8 100644 --- a/tests/Test/Vm.elm +++ b/tests/Test/Vm.elm @@ -27,6 +27,7 @@ emptyVm = , environment = Environment.empty , functionTable = Dict.empty , compiledFunctions = [] + , compiledMacros = [] }