X-Git-Url: https://git.lukelau.me/?p=scheme.git;a=blobdiff_plain;f=ast.scm;h=cfd774a2202cd5af24ae71c7facfd81bd966d63c;hp=c32e47e663d3e8fb2bbe10021eab404ad79c0cf9;hb=6b91111c8d3fd8e617bece8d69f6c98d5e6ef3cb;hpb=639c992ea2c89ef0b6421279a76e637c7f469517

diff --git a/ast.scm b/ast.scm
index c32e47e..cfd774a 100644
--- a/ast.scm
+++ b/ast.scm
@@ -105,15 +105,18 @@
 					; does a cover b
 (define (case-covers? data-layouts a b)
   (let ([a-binding? (and (eqv? (ast-type a) 'var) (not (constructor? data-layouts a)))])
-    (if (eqv? ':binding b)
-	a-binding?
-	(if a-binding?
-	    #t
-	    (if (eqv? (ast-type b) 'var)
-		(eqv? b a)
+    (cond
+     [(eqv? ':binding b) a-binding?]
+     [a-binding? #t]
+					; a literal/singleton
+     [(eqv? (ast-type b) 'var) (eqv? b a)]
+					; two different constructors
+     [(not (eqv? (car a) (car b))) #f]
+					; two same constructors
+     [else
       (all (map (lambda (p q)
 		  (case-covers? data-layouts p q))
-			  (cdr a) (cdr b))))))))
+		(cdr a) (cdr b)))])))
 
 (define (verify-cases data-layouts annotated-program)