mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-11 05:25:28 +03:00
More bugfixes concerning wildcards.
This commit is contained in:
parent
90375fd0ff
commit
7a0ae9de7f
@ -50,7 +50,7 @@
|
||||
(defn wildcard [x]
|
||||
(match x
|
||||
Nothing @"No"
|
||||
_ @"Yes" ;; TODO: Allow underscore here!!!
|
||||
_ @"Yes"
|
||||
))
|
||||
|
||||
(deftype Name
|
||||
|
@ -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 @""))))
|
||||
|
@ -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")
|
||||
|
@ -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
|
||||
|
@ -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")
|
||||
)
|
||||
|
Loading…
Reference in New Issue
Block a user