From 7a0ae9de7f28782e25fda5e24f3ad646e71fc8e5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Erik=20Sved=C3=A4ng?= <erik.svedang@gmail.com>
Date: Tue, 12 Feb 2019 23:01:33 +0100
Subject: [PATCH] More bugfixes concerning wildcards.

---
 examples/sumtypes.carp |  2 +-
 examples/temp.carp     | 22 ++++++++++++++++++++++
 src/Emit.hs            |  3 ++-
 src/InitialTypes.hs    | 14 +++++++++-----
 test/memory.carp       | 21 +++++++++++++++++++++
 5 files changed, 55 insertions(+), 7 deletions(-)

diff --git a/examples/sumtypes.carp b/examples/sumtypes.carp
index a66c93b1..3ee87551 100644
--- a/examples/sumtypes.carp
+++ b/examples/sumtypes.carp
@@ -50,7 +50,7 @@
 (defn wildcard [x]
   (match x
     Nothing @"No"
-    _ @"Yes" ;; TODO: Allow underscore here!!!
+    _ @"Yes"
     ))
 
 (deftype Name
diff --git a/examples/temp.carp b/examples/temp.carp
index 5cfe2eb9..abef6568 100644
--- a/examples/temp.carp
+++ b/examples/temp.carp
@@ -181,3 +181,25 @@
 
 ;; (defn main []
 ;;   (println* (= (Just 10) (Nothing))))
+
+(use Maybe)
+
+(defn wildcard [x]
+  (match x
+    Nothing @"No"
+    (x) @"Yes"
+    ))
+
+(deftype Name
+  (Simple [String String])
+  (Fancy [String String String]))
+
+(use Name)
+
+(defn wildcards-inside [name]
+  (match name
+    (Simple _ _) 1
+    (Fancy _ _ _) 2))
+
+(defn main []
+  (println* (wildcard (Maybe.Just @""))))
diff --git a/src/Emit.hs b/src/Emit.hs
index b8a3e00d..a70f1e97 100644
--- a/src/Emit.hs
+++ b/src/Emit.hs
@@ -307,7 +307,8 @@ toC toCMode root = emitterSrc (execState (visit startingIndent root) (EmitterSta
                        appendToSrc ("if(true) {\n")
                        appendToSrc (addIndent indent' ++ tyToCLambdaFix exprTy ++ " " ++
                                     tempVarToAvoidClash ++ " = " ++ exprVar ++ ";\n")
-                       appendToSrc (addIndent indent' ++ tyToCLambdaFix exprTy ++ " " ++ pathToC firstPath ++ " = " ++ exprVar ++ ";\n") -- Store the whole expr in a variable
+                       appendToSrc (addIndent indent' ++ tyToCLambdaFix exprTy ++ " " ++
+                                    pathToC firstPath ++ " = " ++ tempVarToAvoidClash ++ ";\n") -- Store the whole expr in a variable
                        caseExprRetVal <- visit indent' caseExpr
                        when isNotVoid $
                          appendToSrc (addIndent indent' ++ retVar ++ " = " ++ caseExprRetVal ++ ";\n")
diff --git a/src/InitialTypes.hs b/src/InitialTypes.hs
index 4b82176a..67ee0e25 100644
--- a/src/InitialTypes.hs
+++ b/src/InitialTypes.hs
@@ -237,7 +237,7 @@ initialTypes typeEnv rootEnv root = evalState (visit rootEnv root) 0
         -- Match
         matchExpr@(XObj Match _ _) : expr : cases ->
           do visitedExpr <- visit env expr
-             visitedCases <- fmap sequence $ mapM (\(lhs, rhs) -> do let lhs' = (uniquifyWildcardNames (wrapInParensIfNotSingleVar lhs)) -- Add parens if missing
+             visitedCases <- fmap sequence $ mapM (\(lhs, rhs) -> do let lhs' = (uniquifyWildcardNames (helpWithParens lhs)) -- Add parens if missing
                                                                      env' <- extendEnvWithCaseMatch env lhs'
                                                                      visitedLhs <- visit env' lhs'
                                                                      visitedRhs <- visit env' rhs
@@ -432,9 +432,13 @@ uniquifyWildcardNames (XObj (Arr xobjs) i t) =
 uniquifyWildcardNames x =
   x
 
-wrapInParensIfNotSingleVar :: XObj -> XObj
-wrapInParensIfNotSingleVar xobj@(XObj (Sym (SymPath _ name) _) _ _)
-  | isVarName name = xobj -- DON'T WRAP!
+-- | Help our programmer friend using Carp to add/remove parens around the lhs of a match
+helpWithParens :: XObj -> XObj
+helpWithParens xobj@(XObj (Sym (SymPath _ name) _) _ _)
+  | isVarName name = xobj -- Don't wrap
   | otherwise = wrapInParens xobj
-wrapInParensIfNotSingleVar xobj =
+helpWithParens outer@(XObj (Lst [inner@(XObj (Sym (SymPath _ name) _) _ _)]) _ _)
+  | isVarName name = inner -- Unwrap
+  | otherwise = outer -- Keep wrapped
+helpWithParens xobj =
   wrapInParens xobj
diff --git a/test/memory.carp b/test/memory.carp
index 271a254a..2347b352 100644
--- a/test/memory.carp
+++ b/test/memory.carp
@@ -413,6 +413,25 @@
           (Maybe.Just x) x
           (Maybe.Nothing) @"Nope")))))
 
+(deftype Name
+  (Simple [String String])
+  (Fancy [String String String]))
+
+(defn sumtype-6 []
+  (let [m (Name.Simple @"Mrs" @"Robinson")]
+    (assert
+     (= 1
+        (match m
+          (Name.Simple _ _) 1
+          (Name.Fancy _ _ _) 2)))))
+
+(defn sumtype-7 []
+  (let [m (Name.Fancy @"Mr" @"von" @"Plutt")]
+    (assert
+     (= 1
+        (match m
+          _ 1)))))
+
 (deftest test
   (assert-no-leak test scope-1 "scope-1 does not leak")
   (assert-no-leak test scope-2 "scope-2 does not leak")
@@ -478,4 +497,6 @@
   (assert-no-leak test sumtype-3 "sumtype-3 does not leak")
   (assert-no-leak test sumtype-4 "sumtype-4 does not leak")
   (assert-no-leak test sumtype-5 "sumtype-5 does not leak")
+  (assert-no-leak test sumtype-6 "sumtype-6 does not leak")
+  (assert-no-leak test sumtype-7 "sumtype-7 does not leak")
   )