projects
/
scheme.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
9fd836f
)
Check for let pattern matches that they have only one sum
author
Luke Lau
<luke_lau@icloud.com>
Tue, 13 Aug 2019 13:09:45 +0000
(14:09 +0100)
committer
Luke Lau
<luke_lau@icloud.com>
Tue, 13 Aug 2019 13:09:45 +0000
(14:09 +0100)
ast.scm
patch
|
blob
|
history
tests.scm
patch
|
blob
|
history
diff --git
a/ast.scm
b/ast.scm
index b3f21bd07d6d07ba2b64017cff0a365cbf77abd4..342fe453a4d9276c36237e43e1a7069b5ec75670 100644
(file)
--- a/
ast.scm
+++ b/
ast.scm
@@
-99,10
+99,17
@@
[type (data-tor-type data-layouts sum-name)]
[type (data-tor-type data-layouts sum-name)]
- [sum (assoc sum-name (cdr (assoc type data-layouts)))]
+ [sums (cdr (assoc type data-layouts))]
+ [sum (assoc sum-name sums)]
[expected-number (length (cdr sum))])
[expected-number (length (cdr sum))])
+ ; assert that we only do a let pattern match on an ADT with exactly one sum
+ (when (not (= 1 (length sums)))
+ (error #f (format "Cannot pattern match a ~a in a let since it has ~a possible constructors"
+ type
+ (length sums))))
+
; assert that there is the correct number of bindings
(when (not (= (length products)
expected-number))
; assert that there is the correct number of bindings
(when (not (= (length products)
expected-number))
diff --git
a/tests.scm
b/tests.scm
index fa5b195e1b2575c4d14f9e385c854aad53dd0823..6dfbd9f4459cc1e46b3258caab6d5c0ba0ff2e27 100644
(file)
--- a/
tests.scm
+++ b/
tests.scm
@@
-155,9
+155,7
@@
(test-types
(typecheck
(test-types
(typecheck
- '((data A
- [foo Int]
- [bar Bool])
+ '((data A [foo Int])
(let ([x (foo 42)]
[(foo y) x])
x)))
(let ([x (foo 42)]
[(foo y) x])
x)))
@@
-165,9
+163,7
@@
(test-types
(typecheck
(test-types
(typecheck
- '((data A
- [foo Int]
- [bar Bool])
+ '((data A [foo Int])
(let ([x (foo 42)]
[(foo y) x])
y)))
(let ([x (foo 42)]
[(foo y) x])
y)))
@@
-259,3
+255,8
@@
(let ([(foo x y) (foo (= 3 3) 42)])
y))
42)
(let ([(foo x y) (foo (= 3 3) 42)])
y))
42)
+
+(test-exception (expand-pattern-matches
+ '((data A [foo Int]
+ [bar Bool])
+ (let ([(foo x) (foo 0)]) x))))