diff --git a/.gitignore b/.gitignore index be69446..afb8d1c 100644 --- a/.gitignore +++ b/.gitignore @@ -6,8 +6,10 @@ examples/*.o test/tmp.asm test/*.test test/*.out -test/*.s +test/*.asm test/*.o +*.o +*.asm examples/bf/*.out examples/bf/*.o examples/bf/*.asm diff --git a/PRIMITIVES.md b/PRIMITIVES.md index 0486242..07a4b8a 100644 --- a/PRIMITIVES.md +++ b/PRIMITIVES.md @@ -46,10 +46,10 @@ Special forms are things that are built into the compiler core, and handled spec * `alias!` * Remap functions. See [INTRODUCTION.md](INTRODUCTION.md) for details. -* `cond` - * An efficient switch implementation. * `defconst` * Define an immutable global variable. +* `defmacro` + * Define a macro. * `defun` * Define a function - The function named `main` is both mandatory, and the entry-point to user-scripts. * `defvar` @@ -62,23 +62,28 @@ Special forms are things that are built into the compiler core, and handled spec * Creates a lambda function. * `let` * Create a new scope, with locally bound variables. -* `list` - * Create a list. * `require` * Load a new package, inline. See [INTRODUCTION.md](INTRODUCTION.md) for details. * `set!` * Set the value of a variable. -* `unless` - * Run an unlimited number of expressions when the given condition is false - * `(unless x (expression1) (expression2) ..)` is the same as `(if x nil (do (expression1) (expression2) ..))` -* `when` - * Run an unlimited number of expressions when the given condition is true. - * `(when x (expression1) (expression2) ..)` is the same as `(if x (do (expression1) (expression2) ..))` * `while` * Run the given body for as long as the specified condition is non-nil. +## Quoting + +We have support for the _standard_ quote things, required to implement macros. However our macros are very limited and are more akin to template-expansion. + +* `'x`, or `quote`. +* ```x `` or `quasiquote`. +* `,y` or `unquote`. +* `,@y` or `unquote-splicing`. + +Our lisp-interpreter, inception, has the same support for quoting and unquoting. + + + ## Core Primitives Core primitives are implemented in assembly language, and can be found within the file [compiler/template.tmpl](compiler/template.tmpl) @@ -221,8 +226,6 @@ The implementation of these primitives can be found in the file [stdlib.slisp](s * Add the given key/value to an alist. * `alist:values` * Return all known values from the given alist. -* `and` - * Test if every item in a list is true. * `append` * Append the given value to the specified list. If the list is empty just return the specified item. * `atoi` @@ -282,8 +285,6 @@ The implementation of these primitives can be found in the file [stdlib.slisp](s * Return 1 if the given number is odd, nil otherwise. * `one?` * Return true if the number is one. -* `or` - * Is any value in the given list non-nil? * `plist:new` * Create a new property-list * `plist:get` @@ -333,6 +334,20 @@ The implementation of these primitives can be found in the file [stdlib.slisp](s +## Macros + +We've implemented several primitives as macros, within our standard library [stdlib.slisp](stdlib.slisp): + +* `and` +* `cond` +* `or` +* `unless` +* `when` + +Our lisp-interpreter, inception, has the same support for macros. + + + ## See Also * [README.md](README.md) diff --git a/README.md b/README.md index f498dac..01bb2b3 100644 --- a/README.md +++ b/README.md @@ -50,7 +50,7 @@ You can find bigger examples beneath [examples/](examples/), and our [test/](tes * [test/sort3.lisp](test/sort3.lisp) - A mergesort implementation. * [test/vararg.lisp](test/vararg.lisp) - Demonstration of a function accepting a variable number of arguments. -It should be noted that we prepend a standard library of functions to all user programs unless `-stdlib=false` is added to the command line. That library itself is a useful reference/demonstration of functionality: +It should be noted that we prepend a standard library of functions to all user programs unless `-stdlib=false` is added to the compiler command line. That library itself is a useful reference/demonstration of functionality: * [stdlib.slisp](stdlib.slisp) - Our standard library, written in `slisp` itself. * Has a good `print` definition which handles known types appropriately. @@ -77,7 +77,7 @@ It should be noted that we prepend a standard library of functions to all user p * `=`, `<`, `<=`, `>=`, `>`, and `!` to invert a result. * Special forms (only some of which are valid at the top-level, those are marked with `*`): * `(alias! ..)` - `*` - Alias/overwrite a function. - * `(cond ..)` + * `(defmacro ..)` - `*` - declare a macro. * `(defun ..)` - `*` - declare a function. * `(defconst ..)` - `*` - declare a global constant. * `(defvar ..)`- `*` - declare a global variable. @@ -85,23 +85,24 @@ It should be noted that we prepend a standard library of functions to all user p * `(if ..)` * `(lambda ..)` * `(let ..)` - * `(list ..)` * `(require ..)` - `*` - Include other source files. * `(set! ..)` - * `(unless ..)` - * `(when ..)` * `(while ..)` +* Support for _simple_ macros. + * For example our standard functions `and`, `cond`, `list`, `or`, `unless`, and `when` are implemented as macros. -You can see a complete list of our primitives, and their details in [PRIMITIVES.md](PRIMITIVES.md) - documenting both the built-in special-forms, and the parts of the standard library which are implemented in assembly, or `slisp` itself. +You can see a complete list of our primitives, and their details in [PRIMITIVES.md](PRIMITIVES.md) - this documents the built-in special-forms, the parts of the standard library which are implemented in assembly, those things which are written in `slisp` itself, as well as our predefined macros. Anti-features: -* No macros. - * It wouldn't be impossible to add them, but without `quote`, `quasiquote`, etc, it's a lot of work. -* No `quote` - * Only really useful if you can call `eval` and as a compiler? That's not going to happen easily. -* We don't have "symbols" exposed to the language, but if you prefix a variable with "`:`" it will become visually distinct, and this is useful when working with alists, or plists. - * Internally that is actually translated to a stringified version of the variable name (So `(print :name)` becomes `(print "name")` - that might seem weird but it works for alist/plist usage, etc.) +* Macros (`defmacro`) are a deliberately restricted, non-hygienic, compile-time expansion mechanism. + * A macro body may use bound parameters, literals, `quote`/`quasiquote` templates, a compile-time `if`, and `car`/`cdr`/`nil?` (for recursing over a variadic parameter) to construct its expansion - but not arbitrary compile-time computation (e.g. calling `+` directly against a parameter) + * A macro can't substitute into "raw name" slots - the target of `set!`, `let`-binding names, or `lambda`/`defun` parameter names - since those are parsed as literal tokens, not expressions. + * So you cannot write a decent `dolist` macro that inserts a named variable in the callee scope, however you can use an anaphoric approach. +* We don't have "symbols" exposed to the language. + * You may prefix a variable with "`:`" to make it visually distinct. + * Quoting a bare symbol, e.g. `'foo`, produces the same kind of string. + * So both `:foo` and `'foo` are treated as the string `"foo"`. @@ -253,7 +254,7 @@ Solution 1 (1 5 8 6 3 7 2 4): > Here you'll see we added `--main` which automatically runs the `(main)` function our examples define. -So what are the differences between our _compiler_ and our _interpreter_? Well in some ways the interpreter is more advanced as it has support for `(quote)`, it has a symbol-type, and you can get references to functions using them. The lambdas/defuns are real standalone objects which are treated largely interchangeably and which you can also print. +So what are the differences between our _compiler_ and our _interpreter_? Well in some ways the interpreter is more advanced as it has a real symbol-type, and you can get references to functions using them. The lambdas/defuns are real standalone objects which are treated largely interchangeably and which you can also print. The `alias!` function works for user-defined functions, but sadly doesn't allow you to override or change built-in functions, as they are in a different namespace. This works: @@ -267,8 +268,6 @@ But this doesn't work, if it did we'd have a recursion problem too of course: (alias! string x) (string "steve") -Inception loads the standard library `stdlib.slisp` on startup, to ensure that programs executed by it have the same supporting-functions available as when compiled. The embedded packages contained within `packages/` are also available at run-time with `(require NAME)` as you would expect. - The interpreter is obviously much slower than our compiled binaries, due to the overhead of interpreting everything manually. Sometimes this slowdown is minor, other times it is signification, it really depends upon the nature of the program: * `time ./example` -> 0.006s diff --git a/compiler/compiler.go b/compiler/compiler.go index edf8ed9..63df837 100644 --- a/compiler/compiler.go +++ b/compiler/compiler.go @@ -35,6 +35,10 @@ var registerArguments = []string{ "r9", } +// maxMacroDepth guards against a macro which expands into a call to +// itself (directly, or indirectly). +var maxMacroDepth = 500 + // labelRemapping contains a lookup table of characters that must be remapped // when generating NASM labels. We could replace illegal (non alphanumeric) // characters with just "_", but that would risk collisions if we had functions @@ -109,6 +113,13 @@ type Compiler struct { // globals stores details of top-level global variables globals map[string]parser.Global + + // macros stores the known "defmacro" definitions. + macros map[string]parser.Defmacro + + // macroDepth tracks how many macro-expansions are currently nested, + // this is just to avoid recursion limits. + macroDepth int } // New is our constructor @@ -122,6 +133,7 @@ func New(src string) *Compiler { floats: map[string]float64{}, functions: map[string]*FunctionArgs{}, globals: map[string]parser.Global{}, + macros: map[string]parser.Defmacro{}, loaded: map[string]bool{}, strings: map[string]string{}, } @@ -357,6 +369,10 @@ func (c *Compiler) Compile() (string, error) { Arguments: len(n.Params), Variadic: n.Variadic, } + + case parser.Defmacro: + + c.macros[n.Name] = n } return nil @@ -804,8 +820,28 @@ func (c *Compiler) emitExpr(e parser.Expr, ev *env.Env) error { switch n := e.(type) { case *parser.Call: + // Is this a function call? if symbol, ok := n.Fn.(*parser.Symbol); ok { + // expand macro, if necessary + if macro, ok := c.macros[symbol.Name]; ok { + + if c.macroDepth >= maxMacroDepth { + return fmt.Errorf("macro %s: expansion nested too deeply (possible infinite recursion)", symbol.Name) + } + + c.macroDepth++ + expanded, err := c.expandMacro(symbol.Name, macro, n.Args) + if err != nil { + c.macroDepth-- + return err + } + + err = c.emitExpr(expanded, ev) + c.macroDepth-- + return err + } + // is this variadic? name := symbol.Name v, ok := c.functions[name] @@ -991,47 +1027,6 @@ func (c *Compiler) emitExpr(e parser.Expr, ev *env.Env) error { c.emitln("mov rax, [r15]") c.emitln("call rax") - case *parser.Cond: - - label := c.label("cond_") - - // There are N test/bodies - compile the comparisons to jump to - // each body - for i, cas := range n.Cases { - - err := c.emitExpr(cas.Case, ev) - if err != nil { - return err - } - - c.emitln(" GET_TAG_BITS rax ; get type bits") - c.emitln(" cmp rax, TAG_ID_NIL ; is this a nil?") - c.emitln(fmt.Sprintf(" jnz %s_case_%d", label, i)) - } - - // No match? Then fall-through to return nil - c.emitln(label + "_nil:") - c.emitln(" xor rax, rax") - c.emitln(" TAG_NIL_REG rax") - c.emitln(fmt.Sprintf(" jmp %s_end", label)) - - // now compile each body - making sure execution jumps to the end - for i, cas := range n.Cases { - - // case for each one - c.emitln(fmt.Sprintf("%s_case_%d:", label, i)) - for _, expr := range cas.Exprs { - err := c.emitExpr(expr, ev) - if err != nil { - return err - } - } - c.emitln(fmt.Sprintf(" jmp %s_end", label)) - } - - // define end - c.emitln(label + "_end:") - case *parser.Char: c.emitln(fmt.Sprintf(" mov rax, %d", n.Value)) c.emitln(" TAG_CHAR_REG rax") @@ -1045,7 +1040,6 @@ func (c *Compiler) emitExpr(e parser.Expr, ev *env.Env) error { } case *parser.Float: - // create a label, based on the hash of the content. // This has the side-effect of interning. lbl := c.addThing("float", n.Value) @@ -1057,10 +1051,6 @@ func (c *Compiler) emitExpr(e parser.Expr, ev *env.Env) error { c.emitln(fmt.Sprintf(" lea rax, %s", lbl)) c.emitln(" TAG_FLOAT_REG rax") - case *parser.Int: - c.emitln(fmt.Sprintf(" mov rax, %d", n.Value)) - c.emitln(" TAG_INTEGER_REG rax") - case *parser.If: elseLbl := c.label("else") endLbl := c.label("endif") @@ -1093,8 +1083,11 @@ func (c *Compiler) emitExpr(e parser.Expr, ev *env.Env) error { } c.emitln(endLbl + ":") - case *parser.Lambda: + case *parser.Int: + c.emitln(fmt.Sprintf(" mov rax, %d", n.Value)) + c.emitln(" TAG_INTEGER_REG rax") + case *parser.Lambda: // create a unique name for this lambda name := c.asmName(fmt.Sprintf("lambda_%d", c.labelID)) c.labelID++ @@ -1203,23 +1196,27 @@ func (c *Compiler) emitExpr(e parser.Expr, ev *env.Env) error { } } + case *parser.List: + // Build a list - this is as a result of a macro. + return c.emitExpr(c.evalToList(n.Elems), ev) + case *parser.Nil: c.emitln(" xor rax, rax ; NIL") c.emitln(" TAG_NIL_REG rax ; Tagged") - case *parser.String: - // create a label, based on the hash of the content. - // This has the side-effect of interning. - lbl := c.addThing("string", n.Value) - - // save the string, because we're gonna put it into the - // generated code, later. - c.strings[lbl] = n.Value + case *parser.Quasiquote: + expr, err := c.quoteToExpr(n.Expr, true) + if err != nil { + return err + } + return c.emitExpr(expr, ev) - // load the address of the label and tag. - // same as our float-handling. - c.emitln(fmt.Sprintf(" lea rax, %s", lbl)) - c.emitln(" TAG_STRING_REG rax") + case *parser.Quote: + expr, err := c.quoteToExpr(n.Expr, false) + if err != nil { + return err + } + return c.emitExpr(expr, ev) case *parser.Set: name := n.Name @@ -1255,8 +1252,21 @@ func (c *Compiler) emitExpr(e parser.Expr, ev *env.Env) error { } return fmt.Errorf("unknown variable: %s", n.Name) - case *parser.Symbol: + case *parser.String: + // create a label, based on the hash of the content. + // This has the side-effect of interning. + lbl := c.addThing("string", n.Value) + + // save the string, because we're gonna put it into the + // generated code, later. + c.strings[lbl] = n.Value + + // load the address of the label and tag. + // same as our float-handling. + c.emitln(fmt.Sprintf(" lea rax, %s", lbl)) + c.emitln(" TAG_STRING_REG rax") + case *parser.Symbol: if offset, ok := ev.Lookup(n.Name); ok { c.emitln(fmt.Sprintf( " mov rax, [rbp-%d]", @@ -1280,17 +1290,33 @@ func (c *Compiler) emitExpr(e parser.Expr, ev *env.Env) error { return fmt.Errorf("unknown variable: %s", n.Name) - case *parser.Unless: - endLbl := c.label("unless") + case *parser.Unquote: + return fmt.Errorf("unquote (,) may only appear within a quasiquote") + + case *parser.UnquoteSplicing: + return fmt.Errorf("unquote-splicing (,@) may only appear as a list-element within a quasiquote") + case *parser.While: + // create label for now, and the end + whileStart := c.label("while_start") + whileEnd := c.label("while_end") + + // We're at the start, where we loop again + // to test the condition each time + c.emitln(whileStart + ":") + + // compile the condition err := c.emitExpr(n.Cond, ev) if err != nil { return err } + // If the condition is "nil" we jump + // to the end. Otherwise fall through + // to run the body.. c.emitln(" GET_TAG_BITS rax ; get type bits") c.emitln(" cmp rax, TAG_ID_NIL ; is this a nil?") - c.emitln(" jnz " + endLbl) + c.emitln(" jz " + whileEnd) // assemble the body for _, expr := range n.Exprs { @@ -1300,71 +1326,543 @@ func (c *Compiler) emitExpr(e parser.Expr, ev *env.Env) error { } } - c.emitln(endLbl + ":") + // loop around again + c.emitln(" jmp " + whileStart) - case *parser.When: - endLbl := c.label("when") + // but mark where the body is over. + c.emitln(whileEnd + ":") - err := c.emitExpr(n.Cond, ev) + default: + return fmt.Errorf("emitExpr: Unhandled node type:%T value:%V", n, n) + } + return nil +} + +// evalToList creates a list by calling (cons) appropriately. +func (c *Compiler) evalToList(elems []parser.Expr) parser.Expr { + var acc parser.Expr = &parser.Nil{} + + for i := len(elems) - 1; i >= 0; i-- { + acc = &parser.Call{ + Fn: &parser.Symbol{Name: "cons"}, + Args: []parser.Expr{elems[i], acc}, + } + } + + return acc +} + +// quoteToExpr converts the body of a Quote/Quasiquote expression +// into an ordinary expression which constructs the equivalent +// literal value at runtime. +func (c *Compiler) quoteToExpr(e parser.Expr, quasi bool) (parser.Expr, error) { + + asData := func(name string, inner parser.Expr) (parser.Expr, error) { + quoted, err := c.quoteToExpr(inner, false) if err != nil { - return err + return nil, err } + return c.buildQuotedList([]parser.Expr{&parser.Symbol{Name: name}, quoted}, false) + } - c.emitln(" GET_TAG_BITS rax ; get type bits") - c.emitln(" cmp rax, TAG_ID_NIL ; is this a nil?") - c.emitln(" jz " + endLbl) + switch n := e.(type) { - // assemble the body - for _, expr := range n.Exprs { - err := c.emitExpr(expr, ev) - if err != nil { - return err + case *parser.Call: + elems := append([]parser.Expr{n.Fn}, n.Args...) + return c.buildQuotedList(elems, quasi) + + case *parser.Char: + // self-evaluating literal. + return n, nil + + case *parser.Do: + elems := append([]parser.Expr{&parser.Symbol{Name: "do"}}, n.Exprs...) + return c.buildQuotedList(elems, quasi) + + case *parser.Float: + // self-evaluating literal. + return n, nil + + case *parser.If: + elems := []parser.Expr{&parser.Symbol{Name: "if"}, n.Cond, n.Then} + if n.Else != nil { + elems = append(elems, n.Else) + } + return c.buildQuotedList(elems, quasi) + + case *parser.Int: + // self-evaluating literal. + return n, nil + + case *parser.Lambda: + params := make([]parser.Expr, len(n.Params)) + for i, p := range n.Params { + name := p + if n.Variadic && i == len(n.Params)-1 { + name = "&" + name } + params[i] = &parser.Symbol{Name: name} } + elems := append([]parser.Expr{ + &parser.Symbol{Name: "lambda"}, + &parser.List{Elems: params}, + }, n.Exprs...) + return c.buildQuotedList(elems, quasi) - c.emitln(endLbl + ":") + case *parser.Let: + binds := make([]parser.Expr, len(n.Bindings)) + for i, b := range n.Bindings { + binds[i] = &parser.List{Elems: []parser.Expr{&parser.Symbol{Name: b.Name}, b.Expr}} + } + elems := append([]parser.Expr{ + &parser.Symbol{Name: "let"}, + &parser.List{Elems: binds}, + }, n.Body...) + return c.buildQuotedList(elems, quasi) + + case *parser.List: + return c.buildQuotedList(n.Elems, quasi) + + case *parser.Nil: + // self-evaluating literal. + return n, nil + + case *parser.Quote: + return asData("quote", n.Expr) + + case *parser.Quasiquote: + return asData("quasiquote", n.Expr) + + case *parser.Set: + elems := []parser.Expr{&parser.Symbol{Name: "set!"}, &parser.Symbol{Name: n.Name}, n.Expr} + return c.buildQuotedList(elems, quasi) + + case *parser.String: + // self-evaluating literal. + return n, nil + + case *parser.Symbol: + // conver to a string, just like we do for :foo. + return &parser.String{Value: n.Name}, nil + + case *parser.Unquote: + if quasi { + return n.Expr, nil + } + return asData("unquote", n.Expr) + + case *parser.UnquoteSplicing: + if quasi { + return nil, fmt.Errorf("unquote-splicing (,@) may only appear as a list-element within a quasiquote") + } + return asData("unquote-splicing", n.Expr) case *parser.While: + elems := append([]parser.Expr{&parser.Symbol{Name: "while"}, n.Cond}, n.Exprs...) + return c.buildQuotedList(elems, quasi) - // create label for now, and the end - whileStart := c.label("while_start") - whileEnd := c.label("while_end") + default: + return nil, fmt.Errorf("quote: cannot quote expression of type %T", e) + } +} - // We're at the start, where we loop again - // to test the condition each time - c.emitln(whileStart + ":") +// buildQuotedList converts a list of expressions into an expression which, +// when compiled, builds the equivalent runtime list, via nested "cons" calls. +func (c *Compiler) buildQuotedList(elems []parser.Expr, quasi bool) (parser.Expr, error) { - // compile the condition - err := c.emitExpr(n.Cond, ev) + var acc parser.Expr = &parser.Nil{} + + for i := len(elems) - 1; i >= 0; i-- { + + if spl, ok := elems[i].(*parser.UnquoteSplicing); ok && quasi { + acc = &parser.Call{ + Fn: &parser.Symbol{Name: "append"}, + Args: []parser.Expr{spl.Expr, acc}, + } + continue + } + + converted, err := c.quoteToExpr(elems[i], quasi) if err != nil { - return err + return nil, err } - // If the condition is "nil" we jump - // to the end. Otherwise fall through - // to run the body.. - c.emitln(" GET_TAG_BITS rax ; get type bits") - c.emitln(" cmp rax, TAG_ID_NIL ; is this a nil?") - c.emitln(" jz " + whileEnd) + acc = &parser.Call{ + Fn: &parser.Symbol{Name: "cons"}, + Args: []parser.Expr{converted, acc}, + } + } - // assemble the body - for _, expr := range n.Exprs { - err := c.emitExpr(expr, ev) + return acc, nil +} + +// expandMacro expands a single call to the given macro, with the given +// (literal, unevaluated) argument expressions, and returns the resulting +// expression - ready to be compiled (or, if it is itself a macro-call, +// expanded further). +func (c *Compiler) expandMacro(name string, macro parser.Defmacro, args []parser.Expr) (parser.Expr, error) { + + fixed := len(macro.Params) + if macro.Variadic { + fixed-- + } + + if macro.Variadic { + if len(args) < fixed { + return nil, fmt.Errorf("macro %s expects at least %d argument(s), %d provided", name, fixed, len(args)) + } + } else if len(args) != fixed { + return nil, fmt.Errorf("macro %s expects %d argument(s), %d provided", name, fixed, len(args)) + } + + bindings := map[string]parser.Expr{} + for i := 0; i < fixed; i++ { + bindings[macro.Params[i]] = args[i] + } + if macro.Variadic { + bindings[macro.Params[fixed]] = &parser.List{Elems: append([]parser.Expr{}, args[fixed:]...)} + } + + var result parser.Expr = &parser.Nil{} + for _, expr := range macro.Exprs { + var err error + result, err = c.evalMacroExpr(expr, bindings) + if err != nil { + return nil, fmt.Errorf("error expanding macro %s: %w", name, err) + } + } + + return result, nil +} + +// Only a restricted subset of expressions is supported. +// +// Arbitrary compile-time computation (e.g. calling "+" +// directly on a macro parameter) is not supported. You must use +// a quasiquote template to build the code you want to run instead. +func (c *Compiler) evalMacroExpr(e parser.Expr, bindings map[string]parser.Expr) (parser.Expr, error) { + switch n := e.(type) { + + case *parser.Call: + return c.evalMacroCall(n, bindings) + + case *parser.Char: + return n, nil + + case *parser.Float: + return n, nil + + case *parser.If: + // A compile-time conditional: only the taken branch is ever + // evaluated, which is what lets a macro recurse over a + // variadic parameter until it runs out of arguments. + cond, err := c.evalMacroExpr(n.Cond, bindings) + if err != nil { + return nil, err + } + if isMacroTruthy(cond) { + return c.evalMacroExpr(n.Then, bindings) + } + if n.Else == nil { + return &parser.Nil{}, nil + } + return c.evalMacroExpr(n.Else, bindings) + + case *parser.Int: + return n, nil + + case *parser.Nil: + return n, nil + + case *parser.Quasiquote: + return c.evalQuasiquote(n.Expr, bindings, true) + + case *parser.Quote: + // Quote is always fully literal: no substitution happens, + // even if it happens to contain what looks like a bound + // parameter name. + return n.Expr, nil + + case *parser.String: + return n, nil + + case *parser.Symbol: + if bound, ok := bindings[n.Name]; ok { + return bound, nil + } + return nil, fmt.Errorf("unbound symbol %q in macro body", n.Name) + + default: + return nil, fmt.Errorf("unsupported expression of type %T in macro body: macros may only use bound parameters, literals, if, quote/quasiquote templates, and car/cdr/nil?", e) + } +} + +// isMacroTruthy reports whether a compile-time macro value should be +// treated as "true" by a compile-time "if" - matching the runtime rule +// that only nil (or the empty list) is false. +func isMacroTruthy(e parser.Expr) bool { + switch n := e.(type) { + case *parser.Nil: + return false + case *parser.List: + return len(n.Elems) != 0 + default: + return true + } +} + +// evalMacroCall evaluates a call appearing (outside of any +// quote/quasiquote) within a macro body. Only "car", "cdr" and "nil?" +// are supported: enough structural list-decomposition for a macro to +// recurse over a variadic parameter, one element at a time. +func (c *Compiler) evalMacroCall(n *parser.Call, bindings map[string]parser.Expr) (parser.Expr, error) { + + sym, ok := n.Fn.(*parser.Symbol) + if !ok { + return nil, fmt.Errorf("unsupported call in macro body: the callable must be a bare symbol (car/cdr/nil?)") + } + + switch sym.Name { + case "car", "cdr", "nil?": + // handled below + default: + return nil, fmt.Errorf("unsupported function %q called in macro body: only car/cdr/nil? are supported outside of quote/quasiquote templates", sym.Name) + } + + if len(n.Args) != 1 { + return nil, fmt.Errorf("%s expects exactly one argument in a macro body, got %d", sym.Name, len(n.Args)) + } + + val, err := c.evalMacroExpr(n.Args[0], bindings) + if err != nil { + return nil, err + } + + switch sym.Name { + case "nil?": + elems, convErr := c.asExprList(val) + if convErr == nil && len(elems) == 0 { + return &parser.Int{Value: 1}, nil + } + return &parser.Nil{}, nil + + case "car": + elems, convErr := c.asExprList(val) + if convErr != nil { + return nil, fmt.Errorf("car: %s", convErr) + } + if len(elems) == 0 { + return nil, fmt.Errorf("car: cannot take the first element of an empty list") + } + return elems[0], nil + + case "cdr": + elems, convErr := c.asExprList(val) + if convErr != nil { + return nil, fmt.Errorf("cdr: %s", convErr) + } + if len(elems) == 0 { + return &parser.List{}, nil + } + return &parser.List{Elems: elems[1:]}, nil + } + + return nil, fmt.Errorf("unsupported function %q called in macro body: only car/cdr/nil? are supported outside of quote/quasiquote templates", sym.Name) + +} + +// evalQuasiquote resolves a quasiquote template used within a macro +// body, substituting any "live" Unquote/UnquoteSplicing holes with the +// bound macro-argument expressions, and returns the result. +// +// Unlike quoteToExpr (used to compile a Quasiquote appearing in regular, +// non-macro, code, which always builds a runtime list-value) this +// preserves the *shape* of the template exactly: an "if" in the +// template stays an *parser.If, ready to compile directly as real code, +// rather than being turned into list-data describing an if-expression. +func (c *Compiler) evalQuasiquote(e parser.Expr, bindings map[string]parser.Expr, quasi bool) (parser.Expr, error) { + + switch n := e.(type) { + + case *parser.Unquote: + if quasi { + return c.evalMacroExpr(n.Expr, bindings) + } + inner, err := c.evalQuasiquote(n.Expr, bindings, false) + if err != nil { + return nil, err + } + return &parser.Unquote{Expr: inner}, nil + + case *parser.UnquoteSplicing: + if quasi { + return nil, fmt.Errorf("unquote-splicing (,@) may only appear as a list-element within a quasiquote") + } + inner, err := c.evalQuasiquote(n.Expr, bindings, false) + if err != nil { + return nil, err + } + return &parser.UnquoteSplicing{Expr: inner}, nil + + case *parser.Quote: + // A nested quote is fully inert: it passes through + // untouched, exactly like at the top of evalMacroExpr. + return n, nil + + case *parser.Quasiquote: + inner, err := c.evalQuasiquote(n.Expr, bindings, false) + if err != nil { + return nil, err + } + return &parser.Quasiquote{Expr: inner}, nil + + case *parser.Symbol, *parser.Int, *parser.Float, *parser.String, *parser.Char, *parser.Nil: + // Literal data within the template - untouched. + return n, nil + + case *parser.List: + elems, err := c.evalQuasiquoteList(n.Elems, bindings, quasi) + if err != nil { + return nil, err + } + return &parser.List{Elems: elems}, nil + + case *parser.Call: + fn, err := c.evalQuasiquote(n.Fn, bindings, quasi) + if err != nil { + return nil, err + } + args, err := c.evalQuasiquoteList(n.Args, bindings, quasi) + if err != nil { + return nil, err + } + return &parser.Call{Fn: fn, Args: args}, nil + + case *parser.If: + cond, err := c.evalQuasiquote(n.Cond, bindings, quasi) + if err != nil { + return nil, err + } + then, err := c.evalQuasiquote(n.Then, bindings, quasi) + if err != nil { + return nil, err + } + var els parser.Expr + if n.Else != nil { + els, err = c.evalQuasiquote(n.Else, bindings, quasi) if err != nil { - return err + return nil, err } } + return &parser.If{Cond: cond, Then: then, Else: els}, nil - // loop around again - c.emitln(" jmp " + whileStart) + case *parser.Set: + expr, err := c.evalQuasiquote(n.Expr, bindings, quasi) + if err != nil { + return nil, err + } + return &parser.Set{Name: n.Name, Expr: expr}, nil - // but mark where the body is over. - c.emitln(whileEnd + ":") + case *parser.Do: + exprs, err := c.evalQuasiquoteList(n.Exprs, bindings, quasi) + if err != nil { + return nil, err + } + return &parser.Do{Exprs: exprs}, nil + + case *parser.While: + cond, err := c.evalQuasiquote(n.Cond, bindings, quasi) + if err != nil { + return nil, err + } + exprs, err := c.evalQuasiquoteList(n.Exprs, bindings, quasi) + if err != nil { + return nil, err + } + return &parser.While{Cond: cond, Exprs: exprs}, nil + + case *parser.Let: + binds := make([]parser.Binding, len(n.Bindings)) + for i, b := range n.Bindings { + expr, err := c.evalQuasiquote(b.Expr, bindings, quasi) + if err != nil { + return nil, err + } + binds[i] = parser.Binding{Name: b.Name, Expr: expr} + } + body, err := c.evalQuasiquoteList(n.Body, bindings, quasi) + if err != nil { + return nil, err + } + return &parser.Let{Bindings: binds, Body: body}, nil + + case *parser.Lambda: + exprs, err := c.evalQuasiquoteList(n.Exprs, bindings, quasi) + if err != nil { + return nil, err + } + return &parser.Lambda{Defun: parser.Defun{ + Name: n.Name, + Params: n.Params, + Variadic: n.Variadic, + Exprs: exprs, + }}, nil default: - return fmt.Errorf("emitExpr: Unhandled node type:%T value:%V", n, n) + return nil, fmt.Errorf("quasiquote: cannot process expression of type %T", e) + } +} + +// evalQuasiquoteList processes each element of a quasiquote's list +// content, splicing in the elements of any UnquoteSplicing it finds - +// but only while quasi is true, i.e. we're not inside a further, inert, +// nested quote/quasiquote. +func (c *Compiler) evalQuasiquoteList(elems []parser.Expr, bindings map[string]parser.Expr, quasi bool) ([]parser.Expr, error) { + + var out []parser.Expr + + for _, el := range elems { + + if spl, ok := el.(*parser.UnquoteSplicing); ok && quasi { + val, err := c.evalMacroExpr(spl.Expr, bindings) + if err != nil { + return nil, err + } + + splElems, err := c.asExprList(val) + if err != nil { + return nil, err + } + out = append(out, splElems...) + continue + } + + expr, err := c.evalQuasiquote(el, bindings, quasi) + if err != nil { + return nil, err + } + out = append(out, expr) + } + + return out, nil +} + +// asExprList converts an expression which represents a list - a List, a +// Call (reused, elsewhere, to represent a generic head+args list), or +// Nil (the empty list) - into a plain slice of its elements. It's used +// to splice the result of an UnquoteSplicing (",@") into a surrounding +// list. +func (c *Compiler) asExprList(e parser.Expr) ([]parser.Expr, error) { + switch n := e.(type) { + case *parser.List: + return n.Elems, nil + case *parser.Nil: + return nil, nil + case *parser.Call: + return append([]parser.Expr{n.Fn}, n.Args...), nil + default: + return nil, fmt.Errorf("unquote-splicing (,@) requires a list, got %T", e) } - return nil } // emitVariadicCall compiles a call to a function which expects a variable number of arguments, diff --git a/compiler/compiler_test.go b/compiler/compiler_test.go index a0de48d..6f7d54f 100644 --- a/compiler/compiler_test.go +++ b/compiler/compiler_test.go @@ -60,7 +60,7 @@ func TestBasic(t *testing.T) { (newline)) (foo 32 11) - (print (list 1 2 3 )) + (print (cons 1 (cons 2 (cons 3 nil)))) (print ( (lambda (x) 3) 3)) (do (print 1) @@ -103,3 +103,130 @@ func TestErrors(t *testing.T) { } } } + +// TestQuote confirms that quote/quasiquote/unquote-splicing, appearing +// in ordinary (non-macro) code, compile successfully. +func TestQuote(t *testing.T) { + c := New(` +(defun main () + (print 'hello) + (print '(1 2 3)) + (print '()) + (print '((1 2) (3 4))) + (let ((n 1)) + (print ` + "`(a ,(+ n 1) ,@(cons 3 (cons 4 nil)) b))))" + ` +`) + + out, err := c.Compile() + if err != nil { + t.Fatalf("failed to compile %s", err) + } + if !strings.Contains(out, "call fn_main") { + t.Fatalf("compilation looks bogus") + } +} + +// TestQuoteInert confirms that unquote/unquote-splicing appearing within +// a plain (non-quasi) quote are inert: they become literal data, rather +// than being evaluated. +func TestQuoteInert(t *testing.T) { + c := New(`(defun main () (print '(1 ,foo 2)) (print '(1 ,@foo)))`) + + out, err := c.Compile() + if err != nil { + t.Fatalf("failed to compile %s", err) + } + if !strings.Contains(out, "call fn_main") { + t.Fatalf("compilation looks bogus") + } +} + +// TestQuoteErrors confirms that misuse of unquote/unquote-splicing is +// rejected. +func TestQuoteErrors(t *testing.T) { + tests := []string{ + // unquote outside of a quasiquote. + `(defun main () (print ,foo))`, + // unquote-splicing outside of a quasiquote. + `(defun main () (print ,@foo))`, + // unquote-splicing directly, rather than as a list-element. + `(defun main () (print ` + "`,@foo))" + `)`, + } + + for _, tst := range tests { + c := New(tst) + _, err := c.Compile() + if err == nil { + t.Fatalf("expected error, got none: %s", tst) + } + } +} + +// TestMacro confirms that simple, and variadic, macros expand and +// compile correctly - including recursive expansion (a macro whose +// expansion calls another macro). +func TestMacro(t *testing.T) { + c := New(` +(defmacro cond (&clauses) + (if (nil? clauses) + nil + ` + "`(if ,(car (car clauses))" + ` + (do ,@(cdr (car clauses))) + (cond ,@(cdr clauses))))) + +(defmacro my-if (c then else) + ` + "`(cond (,c ,then) (t ,else)))" + ` + +(defmacro my-unless (c &body) + ` + "`(if ,c nil (do ,@body)))" + ` + +(defmacro my-when-not (c &body) + ` + "`(my-unless ,c ,@body))" + ` + +(defun main () + (print (my-if 1 "yes" "no")) + (my-unless nil (print "a") (print "b")) + (my-when-not nil (print "c"))) +`) + + out, err := c.Compile() + if err != nil { + t.Fatalf("failed to compile %s", err) + } + if !strings.Contains(out, "call fn_main") { + t.Fatalf("compilation looks bogus") + } +} + +// TestMacroErrors confirms a range of malformed macro definitions/calls +// are rejected with an error, rather than compiling to bogus code or +// panicking. +func TestMacroErrors(t *testing.T) { + tests := []string{ + // wrong number of arguments. + `(defmacro m (a b) a) (defun main () (m 1))`, + `(defmacro m (a) a) (defun main () (m 1 2))`, + `(defmacro m (a &b) a) (defun main () (m))`, + + // unbound symbol referenced in the macro body. + `(defmacro m (a) b) (defun main () (m 1))`, + + // arbitrary computation isn't supported - only bound + // parameters, literals, and quote/quasiquote templates. + `(defmacro m (a) (+ a a)) (defun main () (m 1))`, + + // unquote-splicing used somewhere other than a list-element. + `(defmacro m (a) ` + "`,@a)" + ` (defun main () (m 1))`, + + // infinite recursive expansion. + `(defmacro m (a) ` + "`(m ,a))" + ` (defun main () (m 1))`, + } + + for _, tst := range tests { + c := New(tst) + _, err := c.Compile() + if err == nil { + t.Fatalf("expected error, got none: %s", tst) + } + } +} diff --git a/examples/inception.lisp b/examples/inception.lisp index 458117f..75fbc5b 100644 --- a/examples/inception.lisp +++ b/examples/inception.lisp @@ -1,16 +1,13 @@ -;; A minimal lisp interpreter, meant to be compiled with slisp. +;; A lisp interpreter, meant to be compiled with slisp. ;; ;; Features match those of the parent compiler, so we have strings, floats, -;; integers, lambdas, characters, etc. +;; integers, lambdas, characters, etc. We have closures, macros and +;; correctly handle most things. ;; -;; In some ways the interpreter is more advanced than the compiler as it -;; has proper symbols and the (quote..) special form. The downside is -;; that it is slower in the execution of programs. -;; -;; Note that we store built-in primitives, variables, and functions -;; in three different namespaces. We do allow `alias!` to remap -;; a function, and of course defining the same function name a second -;; time will also overwrite the previous version. +;; Note that we store built-in primitives, variables, macros, and functions +;; in distinct namespaces. We do allow `alias!` to remap a function, and +;; of course defining the same function name a second time will also overwrite +;; the previous version. ;; @@ -75,6 +72,9 @@ (defun closure (params body env) (list "closure" params body env)) +(defun macro (params body env) + (list "macro" params body env)) + (defun symbol (name) (list "symbol" name)) @@ -97,6 +97,11 @@ (cons? x) (= (car x) "symbol"))) +(defun macro? (x) + (and + (cons? x) + (= (car x) "macro"))) + ;; And some type-specific helpers. (defun symbol-name (x) @@ -126,6 +131,9 @@ ;; global storage for user-functions (defvar *functions* nil) +;; global storage for macros +(defvar *macros* nil) + ;; global storage for global variables (defvar *globals* nil) @@ -164,6 +172,16 @@ ;; return the name name) +;; add a macro +(defun add-macro (name params body) + (set! *macros* + (tree:put + *macros* + name + (macro params body nil))) + ;; return the name + name) + ;; get all known functions (defun functions (str) "Return the names of user-functions, optionally only those containing the given substring." @@ -203,6 +221,18 @@ nested (tree:get *functions* name)))) +;; get a macro, by name +;; +;; Check for the self-hosted/inception version of the entry first. +(defun lookup-macro (name) + (let ((nested + (tree:get + (global-get "*macros*") + name))) + (if nested + nested + (tree:get *macros* name)))) + ;; lookup a binding from the environment (defun env-get (env name) (tree:get env name)) @@ -405,55 +435,6 @@ (println "Unknown function " new) (list nil env))))) -;; special form: and -(defun eval-and (expr env) - (eval-and-forms (cdr expr) env)) - -(defun eval-and-forms (forms env) - (if (nil? forms) - - ;; (and) => t - (list t env) - - (let ((result (eval (car forms) env))) - - (if (nil? (eval-value result)) - - ;; first false value - result - - ;; last value wins - (if (nil? (cdr forms)) - result - (eval-and-forms - (cdr forms) - (eval-env result))))))) - -;; special form: cond -(defun eval-cond (expr env) - (eval-cond-clauses (cdr expr) env)) - -(defun eval-cond-clauses (clauses env) - (if (nil? clauses) - (list nil env) - - (let ((clause (car clauses))) - - ;; Evaluate the test expression. - (let ((result (eval (car clause) env))) - - (if (eval-value result) - - ;; Test succeeded. - (eval-body - (cdr clause) - (eval-env result)) - - ;; Try the next clause. - (eval-cond-clauses - (cdr clauses) - (eval-env result))))))) - ;; special form: defun (defun eval-defun (expr env) (add-function @@ -464,6 +445,16 @@ ;; return the name of the defun, and the environment (list (cadr expr) env)) +;; special form: defmacro +(defun eval-defmacro (expr env) + (add-macro + (symbol-name (cadr expr)) ; name + (symbols-names (caddr expr)) ; params + (cdddr expr)) ; body + + ;; return the name of the defmacro, and the environment + (list (cadr expr) env)) + ;; special form: defvar - return the value (defun eval-defvar (expr env) (let ((name (symbol-name (cadr expr)))) @@ -521,26 +512,31 @@ (defun eval-list (expr env) (let ((op (symbol-name (car expr)))) (cond - ((= op "alias!") (eval-alias expr env)) - ((= op "and") (eval-and expr env)) - ((= op "cond") (eval-cond expr env)) - ((= op "defconst") (eval-defvar expr env)) - ((= op "defun") (eval-defun expr env)) - ((= op "defvar") (eval-defvar expr env)) - ((= op "do") (eval-do expr env)) - ((= op "if") (eval-if expr env)) - ((= op "lambda") (eval-lambda expr env)) - ((= op "let") (eval-let expr env)) - ((= op "or") (eval-or expr env)) - ((= op "quote") (eval-quote expr env)) - ((= op "require") (eval-require expr env)) - ((= op "set!") (eval-set expr env)) - ((= op "unless") (eval-unless expr env)) - ((= op "when") (eval-when expr env)) - ((= op "while") (eval-while expr env)) - - ;; default - (t (eval-call expr env))))) + ((= op "alias!") (eval-alias expr env)) + ((= op "defconst") (eval-defvar expr env)) + ((= op "defmacro") (eval-defmacro expr env)) + ((= op "defun") (eval-defun expr env)) + ((= op "defvar") (eval-defvar expr env)) + ((= op "do") (eval-do expr env)) + ((= op "if") (eval-if expr env)) + ((= op "lambda") (eval-lambda expr env)) + ((= op "let") (eval-let expr env)) + ((= op "quasiquote") (eval-quasiquote expr env)) + ((= op "quote") (eval-quote expr env)) + ((= op "require") (eval-require expr env)) + ((= op "set!") (eval-set expr env)) + ((= op "while") (eval-while expr env)) + + ;; default: expand a macro-call, or make a genuine function/lambda call + (t (eval-maybe-macro expr env op))))) + +;; If OP names a macro, expand it and evaluate the result. Otherwise +;; treat EXPR as an ordinary function/lambda call. +(defun eval-maybe-macro (expr env op) + (let ((mac (if (str? op) (lookup-macro op) nil))) + (if mac + (eval (expand-macro mac expr) env) + (eval-call expr env)))) ;; eval set! (defun eval-set (expr env) @@ -590,28 +586,52 @@ user (do (println "Unknown function " name) nil))))))))))) -;; special form: or -(defun eval-or (expr env) - (eval-or-forms (cdr expr) env)) - -(defun eval-or-forms (forms env) - (if (nil? forms) - ;; (or) => nil - (list nil env) - - (let ((result (eval (car forms) env))) - (if (eval-value result) - ;; first true value - result - ;; otherwise continue - (eval-or-forms - (cdr forms) - (eval-env result)))))) - ;; special form: quote (defun eval-quote (expr env) (list (cadr expr) env)) +;; special form: quasiquote +(defun eval-quasiquote (expr env) + (list (qq-expand (cadr expr) env) env)) + +;; Is FORM the tagged expression "(NAME ..)" - eg. is FORM the parsed +;; form of "(unquote x)" when NAME is "unquote"? +(defun qq-unquote-form? (form name) + (if (cons? form) + (let ((op (car form))) + (if (cons? op) + (if (str? (car op)) + (if (= (car op) "symbol") + (= (cadr op) name) + nil) + nil) + nil)) + nil)) + +;; Walk FORM, substituting any (unquote ..) or (unquote-splicing ..) +;; found within it, and leaving everything else untouched. +(defun qq-expand (form env) + (cond + ((qq-unquote-form? form "unquote") + (eval-value (eval (cadr form) env))) + ((cons? form) + (qq-expand-list form env)) + (t form))) + +;; Helper for qq-expand, used to walk the elements of a list - handling +;; unquote-splicing of a list-element as a special case. +(defun qq-expand-list (form env) + (if (nil? form) + nil + (let ((head (car form))) + (if (qq-unquote-form? head "unquote-splicing") + (append + (eval-value (eval (cadr head) env)) + (qq-expand-list (cdr form) env)) + (cons + (qq-expand head env) + (qq-expand-list (cdr form) env)))))) + (defun require-path (file) "Find the given file on LISP_PATH, if possible" @@ -668,19 +688,6 @@ (list nil env))) -;; special form: unless -(defun eval-unless (expr env) - (let ((r (eval (cadr expr) env))) - (if (eval-value r) - nil - (eval-body (cdr expr) env)))) - -;; special form: while -(defun eval-when (expr env) - (let ((r (eval (cadr expr) env))) - (if (eval-value r) - (eval-body (cdr expr) env)))) - ;; special form: while (defun eval-while (expr env) (let ((running t) @@ -699,6 +706,25 @@ result)) +;; Bind macro parameters to the unevaluated arguments. +(defun bind-macro-args (params args env) + (cond + ((nil? params) env) + ((variadic-arg? (car params)) + (env-set env (variadic-name (car params)) args)) + (t + (bind-macro-args + (cdr params) + (cdr args) + (env-set env (car params) (car args)))))) + +;; Expand a macro-call, returning the expression it produces. +(defun expand-macro (mac expr) + (let ((params (cadr mac)) + (body (caddr mac)) + (macro-env (bind-macro-args params (cdr expr) nil))) + (eval-value (eval-body body macro-env)))) + ;; apply for built-in and user-functions (defun apply (fn args name) (cond @@ -773,9 +799,11 @@ (newline) (println "Welcome to lisp in slisp; \e[1mInception\e[0m!") (println "Enter :quit to exit.") - (println "NOTE: Help for many functions is available - e.g. (help print)") - (println " Enter '(help-all)' to see all functions and their help-text.") - (println " Available functions may be listed with (functions)") + (println "\nHelp\n====") + (println "Help for most core functions is available - e.g. (help print)") + (println "Run '(help-all [str])' to see all functions [matching str] and their help-text.") + (println "Available functions may be listed with (functions), just those matching a string") + (println "via (functions \"str\").") (newline) (let ((run t)) @@ -809,6 +837,7 @@ (println "Failed to read file")))) + ;; ;; Entry point. ;; diff --git a/lexer/lexer.go b/lexer/lexer.go index 63d53bf..d101c24 100644 --- a/lexer/lexer.go +++ b/lexer/lexer.go @@ -58,6 +58,23 @@ func (l *Lexer) Tokenize() ([]string, error) { l.next() out = append(out, ")") + case '\'': + l.next() + out = append(out, "'") + + case '`': + l.next() + out = append(out, "`") + + case ',': + l.next() + if l.peek() == '@' { + l.next() + out = append(out, ",@") + } else { + out = append(out, ",") + } + case '"': str, err := l.scanStringLiteral() if err != nil { diff --git a/lexer/lexer_test.go b/lexer/lexer_test.go index b9958a4..542f28d 100644 --- a/lexer/lexer_test.go +++ b/lexer/lexer_test.go @@ -160,6 +160,25 @@ func TestCharacterLiteral(t *testing.T) { } +func TestQuoting(t *testing.T) { + + l := New("'a `(1 ,b ,@c)") + out, err := l.Tokenize() + if err != nil { + t.Fatalf("unexpected error tokenizing: %s", err) + } + + expected := []string{"'", "a", "`", "(", "1", ",", "b", ",@", "c", ")"} + if len(out) != len(expected) { + t.Fatalf("unexpected token count %d - %v", len(out), out) + } + for i, tok := range expected { + if out[i] != tok { + t.Fatalf("token %d: expected %q got %q", i, tok, out[i]) + } + } +} + func TestEOF(t *testing.T) { l := New(``) i := 0 diff --git a/packages/lisp-reader.lisp b/packages/lisp-reader.lisp index 3433353..61d726b 100644 --- a/packages/lisp-reader.lisp +++ b/packages/lisp-reader.lisp @@ -84,6 +84,22 @@ (list (list "symbol" "quote") (reader-read))) + ((= (reader-peek) "`") + (reader-next) + (list + (list "symbol" "quasiquote") + (reader-read))) + ((= (reader-peek) ",") + (reader-next) + (if (= (reader-peek) "@") + (do + (reader-next) + (list + (list "symbol" "unquote-splicing") + (reader-read))) + (list + (list "symbol" "unquote") + (reader-read)))) (t (reader-read-atom)))) diff --git a/parser/ast.go b/parser/ast.go index 915d7f8..a071954 100644 --- a/parser/ast.go +++ b/parser/ast.go @@ -4,30 +4,37 @@ package parser // AST // +// Expr is the catchall expression type. type Expr any -// Types +// Basic/Literal Types +// Char holds a character literal. type Char struct { Value byte } +// Float holds a floating point literal. type Float struct { Value float64 } +// Int holds an integer literal. type Int struct { Value int64 } +// String holds a string literal. type String struct { Value string } +// Symbol holds a symbol name. type Symbol struct { Name string } +// Nil holds a nil-literal. type Nil struct { } @@ -43,32 +50,47 @@ type TopLevel interface { Type() string } +// Alias allows rewriting functions, and is designed to allow packages to override +// the default behaviour provided by our standard-library. type Alias struct { Old string New string } -// Type is the implementation of the TopLevel interface +// Type is the implementation of the TopLevel interface. func (d Alias) Type() string { return "alias" } +// Binding holds the name and value of variables within a new scope, started with Let. type Binding struct { Name string Expr Expr } +// Call is used to represent function-calls. type Call struct { Fn Expr Args []Expr } -type CondCase struct { - Case Expr +// Defmacro holds a macro definition. +type Defmacro struct { + // Name of the macro being defined. + Name string + + // The names of the parameter variables. + Params []string + + // Is this macro variadic? + // If so the last argument will be bound to a List of the + // remaining, literal, argument-expressions. + Variadic bool + + // Exprs contains the expressions in the body of the macro. Exprs []Expr } -type Cond struct { - Cases []CondCase -} +// Type is the implementation of the TopLevel interface. +func (d Defmacro) Type() string { return "defmacro" } // Defun holds a function definition. // @@ -88,16 +110,25 @@ type Defun struct { Exprs []Expr } -// Type is the implementation of the TopLevel interface +// Type is the implementation of the TopLevel interface. func (d Defun) Type() string { return "defun" } +// Do allows running multiple expressions in a context where only a single one is permitted. type Do struct { + + // Exprs contains the list of expressions to execute. Exprs []Expr } +// If is our conditional expression. type If struct { + // Cond holds the test to make. Cond Expr + + // Then is the expression executed if the test passes. Then Expr + + // Else (optional) holds the expression executed if the test fails. Else Expr } @@ -118,7 +149,7 @@ type Global struct { Value Expr } -// Type is the implementation of the TopLevel interface +// Type is the implementation of the TopLevel interface. func (d Global) Type() string { return "global" } // Lambda represents a lambda, which is basically identical to a Defun. @@ -132,33 +163,61 @@ type Lambda struct { Captures []string } +// Let introduces a new scope, with the given binings, then executes the named Body. type Let struct { Bindings []Binding Body []Expr } +// List represents a literal sequence of expressions. +// +// This is distinct from a real list, and used internally for parsing. +type List struct { + Elems []Expr +} + +// Quote represents a quoted expression - 'expr - which prevents +// evaluation of expr. +type Quote struct { + Expr Expr +} + +// Quasiquote represents a quasiquoted expression - `expr - which +// behaves like Quote except that any Unquote/UnquoteSplicing nested +// within it are evaluated (or substituted, within a macro body) and +// spliced into the result. +type Quasiquote struct { + Expr Expr +} + +// Require allows loading code from another file, be it an embedded +// package, or a user-provided one. type Require struct { Feature string } -// Type is the implementation of the TopLevel interface +// Type is the implementation of the TopLevel interface. func (r Require) Type() string { return "require" } +// Set allows storing the result of an expression in a variable with the given name. type Set struct { Name string Expr Expr } -type Unless struct { - Cond Expr - Exprs []Expr +// Unquote represents ",expr" - only valid when nested within a Quasiquote. +type Unquote struct { + Expr Expr } -type When struct { - Cond Expr - Exprs []Expr +// UnquoteSplicing represents ",@expr" - only meaningful as a list +// element nested within a Quasiquote. The value of Expr is expected to +// be a list, whose elements are spliced into the surrounding list. +type UnquoteSplicing struct { + Expr Expr } +// While holds a loop construct. type While struct { Cond Expr Exprs []Expr diff --git a/parser/parser.go b/parser/parser.go index a33ffc5..c945e97 100644 --- a/parser/parser.go +++ b/parser/parser.go @@ -1,8 +1,8 @@ // Package parser contains our AST definitions, and the code necessary // to populate them from our input. // -// Most of this package is very minimal stuff, as lisp is very low on -// syntax. +// Most of this package is very minimal stuff, as lisp is very low on syntax. +// However we do have some advanced support for macro-primitives. package parser import ( @@ -92,6 +92,8 @@ func (p *Parser) parseTopLevel() (TopLevel, error) { return p.parseAlias() case "defconst": return p.parseGlobal(tok) + case "defmacro": + return p.parseDefmacro() case "defun": return p.parseDefun() case "defvar": @@ -158,28 +160,27 @@ func (p *Parser) parseGlobal(tok string) (TopLevel, error) { }, nil } -// parseDefun parses a single function definition, containing an arbitrary number -// of expressions within the body. -func (p *Parser) parseDefun() (TopLevel, error) { - - // Get the name - name := p.next() +// parseParams parses a parameter list, necessary for both "defun" and "defmacro". +// +// It returns the raw parameter-names, but records whether the last one should +// be variadic. +func (p *Parser) parseParams(owner string) ([]string, bool, error) { if !p.expectNext("(") { - return nil, fmt.Errorf("expected '(' before defun arguments") + return nil, false, fmt.Errorf("expected '(' before parameter list of %s", owner) } var params []string - variadic := false for p.peek() != ")" && p.peek() != "" { params = append(params, p.next()) } if !p.expectNext(")") { - return nil, fmt.Errorf("expected ')' after defun arguments") + return nil, false, fmt.Errorf("expected ')' after parameter list of %s", owner) } // Updated parameters with "&" removed. tmp := []string{} + variadic := false // If the last, and only the last, argument has a "&" prefix // then it should be removed and the function noted as having @@ -190,12 +191,28 @@ func (p *Parser) parseDefun() (TopLevel, error) { param = after variadic = true } else { - return nil, fmt.Errorf("only the last parameter may have a &-prefix, saw it on %s: %s", name, param) + return nil, false, fmt.Errorf("only the last parameter may have a &-prefix, saw it on %s: %s", owner, param) } } tmp = append(tmp, param) } + return tmp, variadic, nil +} + +// parseDefun parses a single function definition, containing an arbitrary number +// of expressions within the body. +func (p *Parser) parseDefun() (TopLevel, error) { + + // Get the name + name := p.next() + + // parse the parameters + tmp, variadic, err := p.parseParams(name) + if err != nil { + return nil, err + } + // body goes here body := []Expr{} @@ -238,34 +255,93 @@ func (p *Parser) parseDefun() (TopLevel, error) { }, nil } -// buildList is used to turn "(list 1 2 3)" into "(cons 1 (cons 2 (cons 3 nil)))" -func (p *Parser) buildList(args []Expr) Expr { - result := Expr(&Nil{}) - - for i := len(args) - 1; i >= 0; i-- { - result = &Call{ - Fn: &Symbol{Name: "cons"}, - Args: []Expr{ - args[i], - result, - }, +// parseDefmacro parses a single macro definition. +func (p *Parser) parseDefmacro() (TopLevel, error) { + + // Get the name + name := p.next() + + // parse the parameters. + tmp, variadic, err := p.parseParams(name) + if err != nil { + return nil, err + } + + // body goes here + body := []Expr{} + + // allow multiple expressions + for p.peek() != "" && p.peek() != ")" { + // get the expression + expr, err := p.parseExpr() + if err != nil { + return nil, err + } + + // If there are no expressions + if len(body) == 0 { + // And the first expression is a string + // we just ignore it and continue, around this + // loop again. + switch expr.(type) { + case *String: + continue + } } + body = append(body, expr) + + // stop if we see a close + if p.peek() == ")" { + break + } + } + + // and ensure we do see that close + if !p.expectNext(")") { + return nil, fmt.Errorf("expected ')' after defmacro body") } - return result + return Defmacro{ + Name: name, + Params: tmp, + Exprs: body, + Variadic: variadic, + }, nil } // parseExpr parses a single expression, and returns the appropriate AST node. func (p *Parser) parseExpr() (Expr, error) { t := p.peek() + // quote / quasiquote / unquote / unquote-splicing prefixes. + switch t { + case "'", "`", ",", ",@": + p.next() + + inner, err := p.parseExpr() + if err != nil { + return nil, err + } + + switch t { + case "'": + return &Quote{Expr: inner}, nil + case "`": + return &Quasiquote{Expr: inner}, nil + case ",": + return &Unquote{Expr: inner}, nil + default: // ",@" + return &UnquoteSplicing{Expr: inner}, nil + } + } + if t == "(" { return p.parseList() } p.next() - // char + // character literal if after, ok := strings.CutPrefix(t, "#\\"); ok { x := after c := x[0] @@ -287,7 +363,7 @@ func (p *Parser) parseExpr() (Expr, error) { return &Char{Value: byte(c)}, nil } - // string + // string literal if strings.HasPrefix(t, "\"") && strings.HasSuffix(t, "\"") { t = t[1 : len(t)-1] return &String{Value: t}, nil @@ -340,51 +416,7 @@ func (p *Parser) parseList() (Expr, error) { if sym, ok := head.(*Symbol); ok { switch sym.Name { - case "cond": - var cases []CondCase - - for p.peek() == "(" && p.peek() != "" { - - if !p.expectNext("(") { - return nil, fmt.Errorf("expected '(' to open cond-case") - } - - // condition - cond, err := p.parseExpr() - if err != nil { - return nil, err - } - - var exprs []Expr - - // arbitrary number of expressions - for p.peek() != ")" && p.peek() != "" { - x, err := p.parseExpr() - if err != nil { - return nil, err - } - exprs = append(exprs, x) - } - - if !p.expectNext(")") { - return nil, fmt.Errorf("expected ')' to close cond-case") - } - - cases = append(cases, CondCase{ - Case: cond, - Exprs: exprs, - }) - } - - if !p.expectNext(")") { - return nil, fmt.Errorf("expected ')' to close cond") - } - - return &Cond{ - Cases: cases, - }, nil - - case "do", "progn": + case "do": var exprs []Expr @@ -535,24 +567,6 @@ func (p *Parser) parseList() (Expr, error) { Body: body, }, nil - case "list": - var args []Expr - - for p.peek() != ")" && p.peek() != "" { - x, err := p.parseExpr() - if err != nil { - return nil, err - } - args = append(args, x) - } - - if !p.expectNext(")") { - return nil, fmt.Errorf("expected ')' to close list") - } - - lst := p.buildList(args) - return lst, nil - case "set!": name := p.next() expr, err := p.parseExpr() @@ -569,54 +583,6 @@ func (p *Parser) parseList() (Expr, error) { Expr: expr, }, nil - case "unless": - cond, err := p.parseExpr() - if err != nil { - return nil, err - } - - var exprs []Expr - - for p.peek() != ")" && p.peek() != "" { - x, err := p.parseExpr() - if err != nil { - return nil, err - } - exprs = append(exprs, x) - } - - if !p.expectNext(")") { - return nil, fmt.Errorf("expected ')' after unless-expressions") - } - - return &Unless{Cond: cond, - Exprs: exprs, - }, nil - - case "when": - cond, err := p.parseExpr() - if err != nil { - return nil, err - } - - var exprs []Expr - - for p.peek() != ")" && p.peek() != "" { - x, err := p.parseExpr() - if err != nil { - return nil, err - } - exprs = append(exprs, x) - } - - if !p.expectNext(")") { - return nil, fmt.Errorf("expected ')' after when-expressions") - } - - return &When{Cond: cond, - Exprs: exprs, - }, nil - case "while": cond, err := p.parseExpr() if err != nil { diff --git a/parser/parser_test.go b/parser/parser_test.go index c625aed..97a1e08 100644 --- a/parser/parser_test.go +++ b/parser/parser_test.go @@ -150,6 +150,73 @@ func TestEmptyList(t *testing.T) { } } +func TestQuoting(t *testing.T) { + + src := ` +(defmacro my-if (c t e) + ` + "`(cond (,c ,t) (t ,e)))" + ` + +(defun main () + (print 'a) + (print '(1 2 3)) + (print ` + "`(1 ,(+ 1 1) ,@(list 3 4)))" + ` + (my-if 1 2 3)) +` + + p := New(src) + out, err := p.Parse() + if err != nil { + t.Fatalf("unexpected error parsing valid program; %v", err) + } + if len(out) != 2 { + t.Fatalf("expected two top-level expressions, got %d", len(out)) + } + + macro, ok := out[0].(Defmacro) + if !ok { + t.Fatalf("expected first top-level item to be a Defmacro, got %T", out[0]) + } + if macro.Name != "my-if" { + t.Fatalf("unexpected macro name %q", macro.Name) + } + if len(macro.Params) != 3 { + t.Fatalf("expected 3 macro parameters, got %d", len(macro.Params)) + } + if _, ok := macro.Exprs[0].(*Quasiquote); !ok { + t.Fatalf("expected macro body to be a Quasiquote, got %T", macro.Exprs[0]) + } + + def, ok := out[1].(Defun) + if !ok { + t.Fatalf("expected second top-level item to be a Defun") + } + + call, ok := def.Exprs[0].(*Call) + if !ok { + t.Fatalf("expected first expression to be a call to print") + } + if _, ok := call.Args[0].(*Quote); !ok { + t.Fatalf("expected first argument to be a Quote, got %T", call.Args[0]) + } +} + +func TestBrokenQuoting(t *testing.T) { + tests := []string{ + `(defmacro (a) `, + `(defmacro foo (a `, + `(defmacro foo (a) `, + `(defmacro foo (a &b c) 1)`, + } + + for _, txt := range tests { + p := New(txt) + _, err := p.Parse() + if err == nil { + t.Fatalf("expected error parsing %s - got none", txt) + } + } +} + func TestFloat(t *testing.T) { p := New("(defun main() (print 3.1))") out, err := p.Parse() diff --git a/stdlib.slisp b/stdlib.slisp index 7d36788..4f0916d 100644 --- a/stdlib.slisp +++ b/stdlib.slisp @@ -423,19 +423,46 @@ do the right thing for each entry in the given list." ;; ;; Some trivial logical functions which might be useful. -(defun and (&xs) - "Return true if every item in the specified list is true. +(defmacro cond (&clauses) + "Evaluate each clause's test, in turn, stopping at the first one that +is non-nil and returning the value of that clause's last body-expression +(or the test's own value, if the clause has no body). -NOTE: This is not a macro, so all arguments are evaluated." - (let ((res (filter xs (lambda (x) x)))) - (= (length xs) (length res)))) +Returns nil on no match" + (if (nil? clauses) + nil + `(if ,(car (car clauses)) + (do ,@(cdr (car clauses))) + (cond ,@(cdr clauses))))) + +(defmacro and (&xs) + "Return the value of the last argument, so long as every argument up to +that point is non-nil. -(defun or (&xs) - "Return true if any value in the specified list contains a true value. +Stops, and returns nil, as soon as an argument is nil, without evaluating +any remaining remaining arguments." + (if (nil? xs) + t + (if (nil? (cdr xs)) + (car xs) + `(if ,(car xs) (and ,@(cdr xs)) nil)))) -NOTE: This is not a macro, so all arguments are evaluated." - (let ((res (filter xs (lambda (x) x)))) - (> (length res) 0))) +(defmacro or (&xs) + "Return the value of the first non-nil argument, it does not evaluate remaining arguments." + (if (nil? xs) + nil + (if (nil? (cdr xs)) + (car xs) + `(let ((or-value ,(car xs))) + (if or-value or-value (or ,@(cdr xs))))))) + +(defmacro when (c &body) + "Run an unlimited number of expressions when the given condition is true." + `(if ,c (do ,@body))) + +(defmacro unless (c &body) + "Run an unlimited number of expressions when the given condition is false." + `(if ,c nil (do ,@body))) @@ -640,6 +667,13 @@ NOTE: This is not a macro, so all arguments are evaluated." ;; These are functions which are designed to create lists, ;; with ascending values for example. +(defmacro list (&xs) + "Build a list containing the value of each argument, in order. +(list a b c) is the same as (cons a (cons b (cons c nil)))." + (if (nil? xs) + nil + `(cons ,(car xs) (list ,@(cdr xs))))) + (defun nat (n) "Create a list of numbers ranging from 1-N, inclusive." (range 1 n 1)) diff --git a/test/macro.lisp b/test/macro.lisp new file mode 100644 index 0000000..2af7007 --- /dev/null +++ b/test/macro.lisp @@ -0,0 +1,27 @@ +(defmacro my-if (c then else) + "A macro version of 'if'." + `(cond (,c ,then) (t ,else))) + +(defmacro my-unless (c &body) + "A variadic macro." + `(if ,c nil (do ,@body))) + +(defmacro my-or (&args) + "Expands into a runtime list of the (evaluated) arguments." + args) + +(defun main (args) + "Test defmacro." + + (println "yes:" (my-if 1 "yes" "no")) + (println "no:" (my-if nil "yes" "no")) + + (my-unless nil + (println "ran-1") + (println "ran-2")) + + (my-unless 1 + (println "should-not-run")) + + (println (my-or 1 2 3)) +) diff --git a/test/macro.test.expected b/test/macro.test.expected new file mode 100644 index 0000000..2d79364 --- /dev/null +++ b/test/macro.test.expected @@ -0,0 +1,5 @@ +yes:yes +no:no +ran-1 +ran-2 +(1 2 3) diff --git a/test/quote.lisp b/test/quote.lisp new file mode 100644 index 0000000..d2f06ff --- /dev/null +++ b/test/quote.lisp @@ -0,0 +1,20 @@ +(defun main (args) + "Test quote, quasiquote, and unquote-splicing." + + ; a bare symbol is quoted into the equivalent string. + (println 'hello) + + ; a quoted list of literals. + (println '(1 2 3)) + + ; a quoted, empty, list is nil. + (println '()) + + ; quasiquote: literal elements are untouched, unquoted elements are + ; evaluated for real, and unquote-splicing inlines a list. + (let ((n 2)) + (println `(1 ,(+ n 1) ,@(list 4 5) 6))) + + ; nested lists work fine too. + (println '((1 2) (3 4))) +) diff --git a/test/quote.test.expected b/test/quote.test.expected new file mode 100644 index 0000000..e1cfdbc --- /dev/null +++ b/test/quote.test.expected @@ -0,0 +1,5 @@ +hello +(1 2 3) + +(1 3 4 5 6) +((1 2) (3 4))