carp-lang/Carp
1
1
Fork 0
mirror of https://github.com/carp-lang/Carp.git synced 2024-11-04 01:25:04 +03:00
Code Issues Projects Releases Wiki Activity

Nested sumtypes work.

Browse Source
This commit is contained in:
Erik Svedäng 2020-04-29 13:44:13 +02:00
parent e96259fe7e
commit abe61691a3
2 changed files with 18 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
examples/temp.carp
View File

@ -51,10 +51,14 @@
;; Nesting match
(use Maybe)
(defn main []
(let [s (the (Maybe (Maybe String)) (Just (Nothing)))]
(let [s (the (Maybe (Maybe (Maybe String))) (Just (Just (Just @"Oh, but hello."))))]
(match s
(Just (Just x)) (IO.println &x)
_ (IO.println "Didn't match."))))
(Just (Just (Just x))) (println* "It's just just just '" &x "'")
(Just (Just (Nothing))) (IO.println "It's just just nothing.")
(Just (Nothing)) (IO.println "It's just nothing.")
(Nothing) (IO.println "Didn't match.")
_ (IO.println "Unnecessary case.")
)))
;; Match on refs

15
src/Emit.hs
View File

@ -297,6 +297,16 @@ toC toCMode (Binder meta root) = emitterSrc (execState (visit startingIndent roo
isNotVoid = t /= Just UnitTy
sumTypeAsPath = SymPath [] (show exprTy)
tagCondition :: String -> Ty -> XObj -> [String]
tagCondition var caseTy (caseLhs@(XObj (Lst (XObj (Sym firstPath@(SymPath _ caseName) _) _ _ : caseMatchers)) caseLhsInfo _)) =
-- HACK! The function 'removeSuffix' ignores the type specialisation of the tag name and just uses the base name
-- A better idea is to not specialise the names, which happens when calling 'concretize' on the lhs
-- This requires a bunch of extra machinery though, so this will do for now...
[var ++ "._tag == " ++ tagName caseTy (removeSuffix caseName)] ++ concat (zipWith (\c i -> tagCondition (var ++ "." ++ (removeSuffix caseName) ++ ".member" ++ show i) (forceTy c) c) caseMatchers [0..])
tagCondition _ _ x =
[]
--error ("tagCondition fell through: " ++ show x)
tempVarToAvoidClash = freshVar exprInfo ++ "_temp";
emitCaseMatcher :: String -> XObj -> Integer -> State EmitterState ()
@ -315,10 +325,7 @@ toC toCMode (Binder meta root) = emitterSrc (execState (visit startingIndent roo
-- A list of things, beginning with a tag
do appendToSrc (addIndent indent)
unless isFirst (appendToSrc "else ")
-- HACK! The function 'removeSuffix' ignores the type specialisation of the tag name and just uses the base name
-- A better idea is to not specialise the names, which happens when calling 'concretize' on the lhs
-- This requires a bunch of extra machinery though, so this will do for now...
appendToSrc ("if(" ++ exprVar ++ "._tag == " ++ tagName exprTy (removeSuffix caseName) ++ ") {\n")
appendToSrc ("if(" ++ joinWith " && " (tagCondition exprVar exprTy caseLhs) ++ ") {\n")
appendToSrc (addIndent indent' ++ tyToCLambdaFix exprTy ++ " " ++
tempVarToAvoidClash ++ " = " ++ exprVar ++ ";\n")
zipWithM_ (emitCaseMatcher (removeSuffix caseName)) caseMatchers [0..]