More bugfixes concerning wildcards.

examples/sumtypes.carp

@@ -50,7 +50,7 @@
 (defn wildcard [x]
   (match x
     Nothing @"No"
-    _ @"Yes" ;; TODO: Allow underscore here!!!
+    _ @"Yes"
     ))
 
 (deftype Name

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 @""))))

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")

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
+-- | Help our programmer friend using Carp to add/remove parens around the lhs of a match
-wrapInParensIfNotSingleVar xobj@(XObj (Sym (SymPath _ name) _) _ _)
+helpWithParens :: XObj -> XObj
-  | isVarName name = xobj -- DON'T WRAP!
+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

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")
   )