Rakarake/churf
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Case expressions now output constructors correctly this time

Browse source
This commit is contained in:
Rakarake 2023-05-08 19:29:26 +02:00
parent c98166392b
commit 65eb992de4
1 changed files with 17 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

32
src/Monomorphizer/Monomorphizer.hs
View file

@ -326,22 +326,24 @@ morphPattern p expectedType = case p of
L.PCatch -> return $ Just ((M.PCatch, expectedType), Set.empty) L.PCatch -> return $ Just ((M.PCatch, expectedType), Set.empty)
L.PEnum ident -> do L.PEnum ident -> do
let newIdent = newName expectedType ident let newIdent = newName expectedType ident
isMarked <- isConsMarked newIdent morphCons expectedType ident newIdent
if isMarked then return $ Just ((M.PEnum newIdent, expectedType), Set.empty) return $ Just ((M.PEnum newIdent, expectedType), Set.empty)
else return Nothing
L.PInj ident pts -> do let newIdent = newName expectedType ident L.PInj ident pts -> do let newIdent = newName expectedType ident
isMarked <- isConsMarked newIdent ts' <- mapM (getMonoFromPoly . snd) pts
if isMarked morphCons (convertConsTypeToDataType expectedType ts') ident newIdent
then do let pts' = zip (map fst pts) ts'
ts' <- mapM (getMonoFromPoly . snd) pts psSets <- mapM (uncurry morphPattern) pts'
let pts' = zip (map fst pts) ts' let maybePsSets = sequence psSets
psSets <- mapM (uncurry morphPattern) pts' case maybePsSets of
let maybePsSets = sequence psSets Nothing -> return Nothing
case maybePsSets of Just psSets' -> return $ Just
Nothing -> return Nothing ((M.PInj newIdent (map fst psSets'), expectedType), Set.unions $ map snd psSets')
Just psSets' -> return $ Just
((M.PInj newIdent (map fst psSets'), expectedType), Set.unions $ map snd psSets') -- Exampel: List a => a -> List a
else return Nothing convertConsTypeToDataType :: M.Type -> [M.Type] -> M.Type
convertConsTypeToDataType inner (t:ts) = convertConsTypeToDataType (M.TFun t inner) ts
convertConsTypeToDataType inner [] = inner
-- | Creates a new identifier for a function with an assigned type. -- | Creates a new identifier for a function with an assigned type.
newFuncName :: M.Type -> L.Bind -> Ident newFuncName :: M.Type -> L.Bind -> Ident