Add string patterns.

Author: dvanhorn

langs/mountebank/ast.rkt

@@ -51,6 +51,7 @@
 ;;           | (PCons Pat Pat)
 ;;           | (PAnd Pat Pat)
 ;;           | (PSymb Symbol)
+;;           | (PStr String)
 ;; type Lit  = Boolean
 ;;           | Character
 ;;           | Integer
@@ -77,3 +78,4 @@
 (struct PCons (p1 p2)      #:prefab)
 (struct PAnd  (p1 p2)      #:prefab)
 (struct PSymb (s)          #:prefab)
+(struct PStr (s)           #:prefab)

langs/mountebank/compile-expr.rkt

@@ -232,6 +232,24 @@
      (list (seq (Push rax))
            (seq)
            (cons x cm))]
+    [(PStr s)
+     (let ((fail (gensym)))
+       (list (seq (Lea rdi (symbol->data-label (string->symbol s)))
+                  (Mov r8 rax)
+                  (And r8 ptr-mask)
+                  (Cmp r8 type-str)
+                  (Jne fail)
+                  (Xor rax type-str)
+                  (Mov rsi rax)
+                  pad-stack
+                  (Call 'symb_cmp)
+                  unpad-stack
+                  (Cmp rax 0)
+                  (Jne fail))
+             (seq (Label fail)
+                  (Add rsp (* 8 (length cm)))
+                  (Jmp next))
+             cm))]
     [(PSymb s)
      (let ((fail (gensym)))
        (list (seq (Lea r9 (Plus (symbol->data-label s) type-symb))

langs/mountebank/compile-literals.rkt

@@ -55,11 +55,13 @@
     [(Prog ds e)
      (append (append-map literals-d ds) (literals-e e))]))
 
+;; Defn -> [Listof (U Symbol String)]
 (define (literals-d d)
   (match d
     [(Defn f xs e)
      (literals-e e)]))
 
+;; Expr -> [Listof (U Symbol String)]
 (define (literals-e e)
   (match e
     [(Quote d) (literals-datum d)]
@@ -87,10 +89,11 @@
 (define (literals-match-clause p e)
   (append (literals-pat p) (literals-e e)))
 
-;; Pat -> [Listof Symbol]
+;; Pat -> [Listof (U Symbol String)]
 (define (literals-pat p)
   (match p
     [(PSymb s) (list s)]
+    [(PStr s) (list s)]
     [(PBox p) (literals-pat p)]
     [(PCons p1 p2) (append (literals-pat p1) (literals-pat p2))]
     [(PAnd p1 p2) (append (literals-pat p1) (literals-pat p2))]

langs/mountebank/compile.rkt

@@ -44,4 +44,5 @@
        (Extern 'write_byte)
        (Extern 'raise_error)
        (Extern 'intern_symbol)
+       (Extern 'symb_cmp)
        (Extern 'memcpy)))

langs/mountebank/interp-defun.rkt

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

langs/mountebank/interp.rkt

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

langs/mountebank/parse.rkt

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

langs/mountebank/symbol.c

@@ -38,6 +38,8 @@ val_symb_t *intern_symbol(val_symb_t* symb)
 
 int symb_cmp(const val_symb_t *s1, const val_symb_t *s2)
 {
+  if (s1 == s2) return 0;
+
   int64_t len1 = s1->len;
   int64_t len2 = s2->len;
 

langs/mountebank/test/test-runner.rkt

@@ -312,6 +312,8 @@
   (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)
+  (check-equal? (run '(match "foo" ["foo" #t] [_ #f])) #t)
+  (check-equal? (run '(match "foo" ["bar" #t] [_ #f])) #f)
 
   ;; Mountebank examples  
   (check-equal? (run '#())

langs/mug/ast.rkt

@@ -48,6 +48,7 @@
 ;;           | (PCons Pat Pat)
 ;;           | (PAnd Pat Pat)
 ;;           | (PSymb Symbol)
+;;           | (PStr String)
 ;; type Lit  = Boolean
 ;;           | Character
 ;;           | Integer
@@ -79,3 +80,4 @@
 (struct PCons (p1 p2)      #:prefab)
 (struct PAnd  (p1 p2)      #:prefab)
 (struct PSymb (s)          #:prefab)
+(struct PStr (s)           #:prefab)