This has grown into a repo itself, here is the latest version:
The syntax for patterns is
<pat> ::= <var>
| (<symbol> <pat> ...)
The virtual machine for processing patterns has the following instructions
<inst> ::= (bind <var>)
| (compare-and-destructure <sym> <int>)
The virtual machine operates on a stack processing a list of instructions sequentially with an 'early escape' failure continuation. Initially the stack just contains the data being processed as a single element. Instructions are interpreted like this:
(bind <var>)
will pop an element off the top of the stack and bind to it(compare-and-destrcture <sym> <int>)
checks that the top of the stack is a list with CAR equal to and length equal to , if so it appends all the list elements onto the stack otherwise fails.
Compilation is done as follows:
[[ <var> ]] = (bind <var>)
[[ (<symbol> <pat> ...) ]] = (compare-and-destructure <symbol> length-of-list) [[ <pat> ]] ...
The pattern (if a b c)
compiles into (compare-and-destructure if 4) (bind a) (bind b) (bind c)
and matching this against the input data (if #t yes no) would be executed like this:
(list '(if #t yes no))
(list #t 'yes 'no)
{ a = #t }
(list 'yes 'no)
{ b = yes }
(list 'no)
{ c = no }
(list)
Another example is that the pattern (or (t) (f))
would compile into (compare-and-destructure or 3) (compare-and-destructure t 1) (compare-and-destructure f 1)
In order to match an object against a whole list of patterns and share some of the destructuring effort between similar cases we change the virtual machine to process a tree of instructions rather than a linear list. The execution of the VM will run similar to prolog with a depth-first search over the tree with a failure continuation which will be used to roll back and try other cases.
Add the following instruction
<inst> ::= ... | (execute <scheme>)
whose meaning is to run the scheme code inside the bindings that the pattern matcher did.
Compilation is done by compiling each pattern then merging the lists into a tree based on common prefixes.
(define (my-eval exp env)
(match exp
((int i) => i)
((add a b) => (+ (my-eval a env) (my-eval b env)))
((abs p b) => (list 'cls exp env))
((var a) => (cond ((assoc a env) => cdr)
(else (error "unbound variable" a))))
((app f a) => (match (my-eval f env)
((cls (abs p b) cenv) => (my-eval b (cons (cons p (my-eval a env)) cenv)))
(else (error "not a valid function: " f))))
(else (error "invalid expression: " exp))))
(my-eval '(app (app (abs a (abs b (add (var a) (var b)))) (int 1)) (int 2)) '())
;; => 3
take from https://gist.github.com/tca/6aae08b905487f74cfbb
The previous pattern matchers make more sense for matching something like prolog functors than lisp lists. In particular there doesn't seem to be any good way to extend it to support matching for patterns describing variable length lists like (<pattern> . x)
. This is really useful in scheme programming so do implement this we should treat s-expressions as built out of pairs and atoms. Here's a new pattern language syntax:
<pat> ::= <var>
| `<qpat> ; (quasiquote <qpat>)
| '<s-exp> ; (quote <exp>)
<qpat> ::= <sym>
| ,<pat> ; (unquote <qpat>)
| (<qpat> . <qpat>)
The virtual machine now handles slightly different operations
(bind <var>)
(compare-equal? <s-exp>)
- pop off the top of the stack and check that it is equal to expression(compare-eq? <atom>)
(decons)
- Split a cons and push its car, cdr onto the stack (fail if it's not a cons)(execute <body>)
In this version two important bugs were fixed.
- The first in sift-by, the accumulators needed reversed. Without that the ordering of the patterns was being mixed and permuted.
- The second was that variables were being bound even in the failure continuation. The fix for this was to manage a scope manually.
Here is the test case for the second one, on (if x y) it binds t to y in the else case:
;; BUG in pattern matcher found
(define (foo t)
;; #;3> (foo '(if a b))
;; (funcall b)
(match t
(`(if ,b ,t ,e) => (list 'if b t e))
(`(begin . ,rest) => (list 'begin rest))
(`(evil ,x ,x) => (list 'evil x))
(else (list 'funcall t))))