From e4dc23d659849c88cec8c7e57d0d463f9493850e Mon Sep 17 00:00:00 2001
From: Luke Lau <luke_lau@icloud.com>
Date: Tue, 13 Aug 2019 14:09:45 +0100
Subject: [PATCH] Check for let pattern matches that they have only one sum

---
 ast.scm   |  9 ++++++++-
 tests.scm | 13 +++++++------
 2 files changed, 15 insertions(+), 7 deletions(-)

diff --git a/ast.scm b/ast.scm
index b3f21bd..342fe45 100644
--- a/ast.scm
+++ b/ast.scm
@@ -99,10 +99,17 @@
 
 		   [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))])
 
+					; 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))
diff --git a/tests.scm b/tests.scm
index fa5b195..6dfbd9f 100644
--- a/tests.scm
+++ b/tests.scm
@@ -155,9 +155,7 @@
 
 (test-types
  (typecheck
-  '((data A
-	  [foo Int]
-	  [bar Bool])
+  '((data A [foo Int])
     (let ([x (foo 42)]
 	  [(foo y) x])
       x)))
@@ -165,9 +163,7 @@
 
 (test-types
  (typecheck
-  '((data A
-	  [foo Int]
-	  [bar Bool])
+  '((data A [foo Int])
     (let ([x (foo 42)]
 	  [(foo y) x])
       y)))
@@ -259,3 +255,8 @@
 	     (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))))
-- 
2.30.2