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