projects
/
scheme.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Fix total pattern match verification
[scheme.git]
/
ast.scm
diff --git
a/ast.scm
b/ast.scm
index c32e47e663d3e8fb2bbe10021eab404ad79c0cf9..cfd774a2202cd5af24ae71c7facfd81bd966d63c 100644
(file)
--- 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)))])
; 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))
(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)
(define (verify-cases data-layouts annotated-program)