Add symbol patterns.

Author: dvanhorn

langs/mountebank/compile-expr.rkt

@@ -232,6 +232,15 @@
      (list (seq (Push rax))
            (seq)
            (cons x cm))]
+    [(PSymb s)
+     (let ((fail (gensym)))
+       (list (seq (Lea r9 (Plus (symbol->data-label s) type-symb))
+                  (Cmp rax r9)
+                  (Jne fail))
+             (seq (Label fail)
+                  (Add rsp (* 8 (length cm)))
+                  (Jmp next))
+             cm))]
     [(PLit l)
      (let ((fail (gensym)))
        (list (seq (Cmp rax (imm->bits l))

langs/mountebank/interp-defun.rkt

@@ -104,6 +104,7 @@
   (match p
     [(PWild) r]
     [(PVar x) (ext r x v)]
+    [(PSymb s) (and (eq? s v) r)]
     [(PLit l) (and (eqv? l v) r)]
     [(PBox p)
      (match v

langs/mountebank/interp.rkt

@@ -103,6 +103,7 @@
   (match p
     [(PWild) r]
     [(PVar x) (ext r x v)]
+    [(PSymb s) (and (eq? s v) r)]
     [(PLit l) (and (eqv? l v) r)]
     [(PBox p)
      (match v

langs/mountebank/parse.rkt

@@ -67,14 +67,20 @@
     [(? char?)    (PLit p)]
     ['_           (PWild)]
     [(? symbol?)  (PVar p)]
+    [(list 'quote s) (PSymb s)]
     [(list 'quote (list))
      (PLit '())]
     [(list 'box p)
      (PBox (parse-pat p))]
     [(list 'cons p1 p2)
      (PCons (parse-pat p1) (parse-pat p2))]
     [(list 'and p1 p2)
-     (PAnd (parse-pat p1) (parse-pat p2))]))
+     (PAnd (parse-pat p1) (parse-pat p2))]
+    [(cons 'list '())
+     (PLit '())]
+    [(cons 'list (cons p1 ps))
+     (PCons (parse-pat p1)
+            (parse-pat (cons 'list ps)))]))
 
 ;; Datum -> Datum
 (define (parse-datum d)

langs/mountebank/test/test-runner.rkt

@@ -310,6 +310,8 @@
   (check-equal? (run ''foo) 'foo)
   (check-equal? (run '(eq? (match #t [_ "foo"]) "bar")) #f)
   (check-equal? (run '(eq? (match #t [_ 'foo]) 'bar)) #f)
+  (check-equal? (run '(match 'foo ['bar #t] [_ #f])) #f)
+  (check-equal? (run '(match 'foo ['foo #t] [_ #f])) #t)
 
   ;; Mountebank examples  
   (check-equal? (run '#())

langs/mug/compile-expr.rkt

@@ -248,6 +248,15 @@
      (list (seq (Push rax))
            (seq)
            (cons x cm))]
+    [(PSymb s)
+     (let ((fail (gensym)))
+       (list (seq (Lea r9 (Plus (symbol->data-label s) type-symb))
+                  (Cmp rax r9)
+                  (Jne fail))
+             (seq (Label fail)
+                  (Add rsp (* 8 (length cm)))
+                  (Jmp next))
+             cm))]
     [(PLit l)
      (let ((fail (gensym)))
        (list (seq (Cmp rax (imm->bits l))

langs/mug/interp-defun.rkt

@@ -112,6 +112,7 @@
   (match p
     [(PWild) r]
     [(PVar x) (ext r x v)]
+    [(PSymb s) (and (eq? s v) r)]
     [(PLit l) (and (eqv? l v) r)]
     [(PBox p)
      (match v

langs/mug/interp.rkt

@@ -111,6 +111,7 @@
   (match p
     [(PWild) r]
     [(PVar x) (ext r x v)]
+    [(PSymb s) (and (eq? s v) r)]
     [(PLit l) (and (eqv? l v) r)]
     [(PBox p)
      (match v

langs/mug/parse.rkt

@@ -71,6 +71,7 @@
     [(? char?)    (PLit p)]
     ['_           (PWild)]
     [(? symbol?)  (PVar p)]
+    [(list 'quote s) (PSymb s)]
     [(list 'quote (list))
      (PLit '())]
     [(list 'box p)

langs/mug/test/test-runner.rkt

@@ -309,7 +309,9 @@
   (check-equal? (run '(eq? (symbol->string 'foo) "foo")) #f)
   (check-equal? (run ''foo) 'foo)
   (check-equal? (run '(eq? (match #t [_ "foo"]) "bar")) #f)
-  (check-equal? (run '(eq? (match #t [_ 'foo]) 'bar)) #f))
+  (check-equal? (run '(eq? (match #t [_ 'foo]) 'bar)) #f)
+  (check-equal? (run '(match 'foo ['bar #t] [_ #f])) #f)
+  (check-equal? (run '(match 'foo ['foo #t] [_ #f])) #t))
 
 (define (test-runner-io run)
   ;; Evildoer examples