carp-lang/Carp
1
1
Fork 0
mirror of https://github.com/carp-lang/Carp.git synced 2024-09-17 16:38:14 +03:00
Code Issues Projects Releases Wiki Activity

fix: Filter unit types in a few more emissions (#1046)

Browse Source 
There are a lot of different places that we need to filter Units out in
order to support them as type members, this commit catches a few more
cases that we missed:

- Lambda env captures
- Case matchers

Fixes issue #1044
This commit is contained in:
Scott Olsen 2020-12-02 18:02:43 -05:00 committed by GitHub
parent 7920a751bf
commit 88cffce626
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
1 changed files with 5 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/Emit.hs
View File

@ -267,7 +267,7 @@ toC toCMode (Binder meta root) = emitterSrc (execState (visit startingIndent roo
++ ";\n"
)
)
capturedVars
(remove (isUnit . forceTy) capturedVars)
appendToSrc (addIndent indent ++ "Lambda " ++ retVar ++ " = {\n")
appendToSrc (addIndent indent ++ " .callback = (void*)" ++ callbackMangled ++ ",\n")
appendToSrc (addIndent indent ++ " .env = " ++ (if needEnv then lambdaEnvName else "NULL") ++ ",\n")
@ -303,7 +303,7 @@ toC toCMode (Binder meta root) = emitterSrc (execState (visit startingIndent roo
do
ret <- visit indent' expr
let Just bindingTy = xobjTy expr
when (bindingTy /= UnitTy) $
when ((not . isUnit) bindingTy) $
appendToSrc (addIndent indent' ++ tyToCLambdaFix bindingTy ++ " " ++ mangle symName ++ " = " ++ ret ++ ";\n")
letBindingToC _ _ = error "Invalid binding."
mapM_ (uncurry letBindingToC) (pairwise bindings)
@ -349,9 +349,10 @@ toC toCMode (Binder meta root) = emitterSrc (execState (visit startingIndent roo
-- 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...
-- TODO probably we want to filter Units from caseMatchers here
[var ++ periodOrArrow ++ "_tag == " ++ tagName caseTy (removeSuffix caseName)]
++ concat (zipWith (\c i -> tagCondition (var ++ periodOrArrow ++ "u." ++ removeSuffix caseName ++ ".member" ++ show i) "." (forceTy c) c) caseMatchers ([0 ..] :: [Int]))
++ concat (zipWith (\c i -> tagCondition (var ++ periodOrArrow ++ "u." ++ removeSuffix caseName ++ ".member" ++ show i) "." (forceTy c) c) unitless ([0 ..] :: [Int]))
where
unitless = remove (isUnit . forceTy) caseMatchers
tagCondition _ _ _ _ =
[]
--error ("tagCondition fell through: " ++ show x)