boot2

Playing with the boostrap
git clone https://git.ryansepassi.com/git/boot2.git
Log | Files | Refs | README

092-pmatch-compiler-dispatch.scm (1351B)

      1 ; The exact compiler form-dispatch shape from LISP-PMATCH.md. This is the
      2 ; reason pmatch is built in: every form the self-hosted compiler walks is
      3 ; structured this way.
      4 
      5 (define (kind e)
      6   (pmatch e
      7     ((quote ,_)             'lit)
      8     ((if ,_ ,_ ,_)          'if)
      9     ((lambda ,_ . ,_)       'lambda)
     10     ((set! ,_ ,_)           'set!)
     11     (,x (guard (symbol? x)) 'var)
     12     (,x (guard (integer? x)) 'int)
     13     ((,_ . ,_)              'call)
     14     (else                   'unknown)))
     15 
     16 (if (eq? (kind '(quote x))             'lit)    0 (sys-exit 1))
     17 (if (eq? (kind '(if a b c))            'if)     0 (sys-exit 2))
     18 (if (eq? (kind '(lambda (x) x))        'lambda) 0 (sys-exit 3))
     19 (if (eq? (kind '(lambda (x y) x y))    'lambda) 0 (sys-exit 4))
     20 (if (eq? (kind '(set! a 1))            'set!)   0 (sys-exit 5))
     21 (if (eq? (kind 'foo)                   'var)    0 (sys-exit 6))
     22 (if (eq? (kind 42)                     'int)    0 (sys-exit 7))
     23 (if (eq? (kind '(f 1 2))               'call)   0 (sys-exit 8))
     24 (if (eq? (kind "hi")                   'unknown) 0 (sys-exit 9))
     25 
     26 ;; Destructure a let-clause as the spec example shows.
     27 (define (split-let-clause c)
     28   (pmatch c
     29     ((,name ,init) (cons name init))
     30     (else (sys-exit 95))))
     31 (define p (split-let-clause '(x 42)))
     32 (if (eq? (car p) 'x) 0 (sys-exit 10))
     33 (if (= (cdr p) 42)   0 (sys-exit 11))
     34 
     35 (sys-exit 0)