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

Added check for recursive calls

Browse source
This commit is contained in:
Rakarake 2023-03-08 17:52:41 +01:00
parent d377ded7e1
commit 0e20670343
1 changed files with 15 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

17
src/Monomorpher/Monomorpher.hs
View file

@ -26,7 +26,7 @@ module Monomorpher.Monomorpher (monomorphize, morphExp, morphBind) where
import qualified TypeChecker.TypeCheckerIr as T import qualified TypeChecker.TypeCheckerIr as T
import qualified Monomorpher.MonomorpherIr as M import qualified Monomorpher.MonomorpherIr as M
import Grammar.Abs (Ident) import Grammar.Abs (Ident (Ident))
import Control.Monad.State (MonadState (get), State, gets, modify, execState) import Control.Monad.State (MonadState (get), State, gets, modify, execState)
import qualified Data.Map as Map import qualified Data.Map as Map
@ -43,7 +43,8 @@ data Env = Env { -- | All binds in the program.
polys :: Map.Map Ident M.Type, polys :: Map.Map Ident M.Type,
-- | Local variables, not necessary if id's are annotated based -- | Local variables, not necessary if id's are annotated based
-- on if they are local or global. -- on if they are local or global.
locals :: Set.Set Ident locals :: Set.Set Ident,
currentFunc :: Ident
} deriving (Show) } deriving (Show)
-- | State Monad wrapper for "Env". -- | State Monad wrapper for "Env".
@ -55,7 +56,8 @@ createEnv :: [T.Bind] -> Env
createEnv binds = Env { input = Map.fromList kvPairs, createEnv binds = Env { input = Map.fromList kvPairs,
output = Map.empty, output = Map.empty,
polys = Map.empty, polys = Map.empty,
locals = Set.empty } locals = Set.empty,
currentFunc = Ident "main" }
where where
kvPairs :: [(Ident, T.Bind)] kvPairs :: [(Ident, T.Bind)]
kvPairs = map (\b@(T.Bind (ident, _) _ _) -> (ident, b)) binds kvPairs = map (\b@(T.Bind (ident, _) _ _) -> (ident, b)) binds
@ -75,6 +77,11 @@ localExists :: Ident -> EnvM Bool
localExists ident = do env <- get localExists ident = do env <- get
return $ Set.member ident (locals env) return $ Set.member ident (locals env)
-- | Gets whether ident is current function.
isCurrentFunc :: Ident -> EnvM Bool
isCurrentFunc ident = do env <- get
return $ ident == currentFunc env
-- | Gets a polymorphic bind from an id. -- | Gets a polymorphic bind from an id.
getPolymorphic :: Ident -> EnvM (Maybe T.Bind) getPolymorphic :: Ident -> EnvM (Maybe T.Bind)
getPolymorphic ident = gets (Map.lookup ident . input) getPolymorphic ident = gets (Map.lookup ident . input)
@ -180,7 +187,11 @@ morphExp expectedType exp = case exp of
case bind of case bind of
Nothing -> error "Wowzers!" Nothing -> error "Wowzers!"
Just bind' -> do Just bind' -> do
maybeCurrentFunc <- isCurrentFunc ident
t' <- getMono t t' <- getMono t
if maybeCurrentFunc then
return ()
else
morphBind t' bind' morphBind t' bind'
return $ M.EId (ident, t') return $ M.EId (ident, t')