X-Git-Url: https://git.lukelau.me/?p=scheme.git;a=blobdiff_plain;f=ast.scm;h=cfd774a2202cd5af24ae71c7facfd81bd966d63c;hp=eabad585fec27b4f6c83f3c747ca0c7925a80de2;hb=HEAD;hpb=fff1029008b7399f597e0227fff2bf05b8a27b3c

diff --git a/ast.scm b/ast.scm
index eabad58..cfd774a 100644
--- a/ast.scm
+++ b/ast.scm
@@ -25,7 +25,6 @@
    ((builtin? x) 'builtin)
    ((symbol? x) 'var)
    ((integer? x) 'int-literal)
-   ((boolean? x) 'bool-literal)
    ((string? x) 'string-literal)))
 
 (define (ast-traverse f x)
@@ -106,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)