Simplified pattern matching from lecture.

Author: dvanhorn

langs/knock/compile.rkt

@@ -218,84 +218,77 @@
 (define (compile-match-clause p e c done t?)
   (let ((next (gensym)))
     (match (compile-pattern p '() next)
-      [(list i f cm)
+      [(list i cm)
        (seq (Mov rax (Offset rsp 0)) ; restore value being matched
             i
             (compile-e e (append cm c) t?)
             (Add rsp (* 8 (length cm)))
             (Jmp done)
-            f
             (Label next))])))
 
-;; Pat CEnv Symbol -> (list Asm Asm CEnv)
+;; Pat CEnv Symbol -> (list Asm CEnv)
 (define (compile-pattern p cm next)
   (match p
     [(PWild)
-     (list (seq) (seq) cm)]
+     (list (seq) cm)]
     [(PVar x)
-     (list (seq (Push rax))
-           (seq)
-           (cons x cm))]
+     (list (seq (Push rax)) (cons x cm))]
     [(PLit l)
-     (let ((fail (gensym)))
+     (let ((ok (gensym)))
        (list (seq (Cmp rax (value->bits l))
-                  (Jne fail))
-             (seq (Label fail)
+                  (Je ok)
                   (Add rsp (* 8 (length cm)))
-                  (Jmp next))
+                  (Jmp next)
+                  (Label ok))
              cm))]
     [(PAnd p1 p2)
      (match (compile-pattern p1 (cons #f cm) next)
-       [(list i1 f1 cm1)
+       [(list i1 cm1)
         (match (compile-pattern p2 cm1 next)
-          [(list i2 f2 cm2)
+          [(list i2 cm2)
            (list
             (seq (Push rax)
                  i1
                  (Mov rax (Offset rsp (* 8 (- (sub1 (length cm1)) (length cm)))))
                  i2)
-            (seq f1 f2)
             cm2)])])]
     [(PBox p)
      (match (compile-pattern p cm next)
-       [(list i1 f1 cm1)
-        (let ((fail (gensym)))
+       [(list i1 cm1)
+        (let ((ok (gensym)))
           (list
            (seq (Mov r8 rax)
                 (And r8 ptr-mask)
                 (Cmp r8 type-box)
-                (Jne fail)
+                (Je ok)
+                (Add rsp (* 8 (length cm))) ; haven't pushed anything yet
+                (Jmp next)
+                (Label ok)
                 (Xor rax type-box)
                 (Mov rax (Offset rax 0))
                 i1)
-           (seq f1
-                (Label fail)
-                (Add rsp (* 8 (length cm))) ; haven't pushed anything yet
-                (Jmp next))
            cm1))])]
     [(PCons p1 p2)
      (match (compile-pattern p1 (cons #f cm) next)
-       [(list i1 f1 cm1)
+       [(list i1 cm1)
         (match (compile-pattern p2 cm1 next)
-          [(list i2 f2 cm2)
-           (let ((fail (gensym)))
+          [(list i2 cm2)
+           (let ((ok (gensym)))
              (list
               (seq (Mov r8 rax)
                    (And r8 ptr-mask)
                    (Cmp r8 type-cons)
-                   (Jne fail)                   
+                   (Je ok)
+                   (Add rsp (* 8 (length cm))) ; haven't pushed anything yet
+                   (Jmp next)
+                   (Label ok)
                    (Xor rax type-cons)
                    (Mov r8 (Offset rax 0))
                    (Push r8)                ; push cdr
                    (Mov rax (Offset rax 8)) ; mov rax car
                    i1
                    (Mov rax (Offset rsp (* 8 (- (sub1 (length cm1)) (length cm)))))
                    i2)
-              (seq f1
-                   f2
-                   (Label fail)
-                   (Add rsp (* 8 (length cm))) ; haven't pushed anything yet
-                   (Jmp next))
               cm2))])])]))
 
 ;; Id CEnv -> Integer