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

Data defs in monomorphizer output environment

Browse source
This commit is contained in:
Rakarake 2023-03-29 17:05:56 +02:00
parent 53589e8d50
commit 29fcddf44c
1 changed files with 7 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

25
src/Monomorphizer/Monomorphizer.hs
View file

@ -43,7 +43,7 @@ newtype EnvM a = EnvM (StateT Output (Reader Env) a)
type Output = Map.Map Ident Outputted type Output = Map.Map Ident Outputted
-- When a bind is being processed, it is Incomplete in the state, also -- When a bind is being processed, it is Incomplete in the state, also
-- called marked. -- called marked.
data Outputted = Incomplete | Complete M.Bind data Outputted = Incomplete | Complete M.Bind | Data M.Data
-- Static environment -- Static environment
data Env = Env { data Env = Env {
@ -150,15 +150,6 @@ convertLit :: T.Lit -> M.Lit
convertLit (T.LInt v) = M.LInt v convertLit (T.LInt v) = M.LInt v
convertLit (T.LChar v) = M.LChar v convertLit (T.LChar v) = M.LChar v
-- | Conv
--data Pattern' t
-- = PVar (Id' t) -- TODO should be Ident
-- | PLit (Lit, t) -- TODO should be Lit
-- | PCatch
-- | PEnum Ident
-- | PInj Ident [Pattern' t] -- TODO should be (Pattern' t, t)
-- deriving (C.Eq, C.Ord, C.Show, C.Read)
morphExp :: M.Type -> T.Exp -> EnvM M.Exp morphExp :: M.Type -> T.Exp -> EnvM M.Exp
morphExp expectedType exp = case exp of morphExp expectedType exp = case exp of
T.ELit lit -> return $ M.ELit (convertLit lit) T.ELit lit -> return $ M.ELit (convertLit lit)
@ -214,7 +205,7 @@ morphPattern = \case
T.PInj ident ps -> do ps' <- mapM morphPattern ps T.PInj ident ps -> do ps' <- mapM morphPattern ps
return $ M.PInj ident ps' return $ M.PInj ident ps'
-- Creates a new identifier for a function with an assigned type -- | Creates a new identifier for a function with an assigned type
newName :: M.Type -> T.Bind -> Ident newName :: M.Type -> T.Bind -> Ident
newName t (T.Bind (Ident bindName, _) _ _) = newName t (T.Bind (Ident bindName, _) _ _) =
if bindName == "main" then if bindName == "main" then
@ -227,7 +218,7 @@ newName t (T.Bind (Ident bindName, _) _ _) =
-- Monomorphization step -- Monomorphization step
monomorphize :: T.Program -> M.Program monomorphize :: T.Program -> M.Program
monomorphize (T.Program defs) = M.Program $ (getDefsFromBinds . getBindsFromOutput) monomorphize (T.Program defs) = M.Program $ getDefsFromOutput
(runEnvM Map.empty (createEnv defs) monomorphize') (runEnvM Map.empty (createEnv defs) monomorphize')
where where
monomorphize' :: EnvM () monomorphize' :: EnvM ()
@ -249,11 +240,12 @@ createEnv defs = Env { input = Map.fromList bindPairs,
bindPairs = (map (\b -> (getBindName b, b)) . getBindsFromDefs) defs bindPairs = (map (\b -> (getBindName b, b)) . getBindsFromDefs) defs
-- Helper functions -- Helper functions
getBindsFromOutput :: Output -> [M.Bind] getDefsFromOutput :: Output -> [M.Def]
getBindsFromOutput outputMap = (map snd . Map.toList) $ fmap getDefsFromOutput outputMap = (map snd . Map.toList) $ fmap
(\case (\case
Incomplete -> error "Internal bug in monomorphizer" Incomplete -> error "Internal bug in monomorphizer"
Complete b -> b ) Complete b -> M.DBind b
Data d -> M.DData d)
outputMap outputMap
getBindsFromDefs :: [T.Def] -> [T.Bind] getBindsFromDefs :: [T.Def] -> [T.Bind]
@ -261,9 +253,6 @@ getBindsFromDefs = foldl (\bs -> \case
T.DBind b -> b:bs T.DBind b -> b:bs
T.DData _ -> bs) [] T.DData _ -> bs) []
getDefsFromBinds :: [M.Bind] -> [M.Def]
getDefsFromBinds = foldl (\ds b -> M.DBind b : ds) []
getBindName :: T.Bind -> Ident getBindName :: T.Bind -> Ident
getBindName (T.Bind (ident, _) _ _) = ident getBindName (T.Bind (ident, _) _ _) = ident