Le.hs revision 715a002611e0c503c11cc3aa80835763215e689d
10397bcc134edbcfbe3ae2c7ea4c6080036aae22Christian Maeder Authors: Christian Maeder
3f69b6948966979163bdfe8331c38833d5d90ecdChristian Maeder abstract syntax after/during static analysis
4b0a4c7dea0f67a233dcc42ce9bb18d36de109aeChristian Maedermodule Le where
e8ffec0fa3d3061061bdc16e44247b9cf96b050fChristian Maederimport FiniteMap
f8f78a2c8796a387a4348cc672ae08e8d9f69315Christian Maederimport MonadState
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder-----------------------------------------------------------------------------
af621d0066770895fd79562728e93099c8c52060Christian Maeder-----------------------------------------------------------------------------
e8ffec0fa3d3061061bdc16e44247b9cf96b050fChristian Maederdata ClassInfo = ClassInfo { superClasses :: [ClassId]
79d11c2e3ad242ebb241f5d4a5e98a674c0b986fChristian Maeder , classDefn :: Maybe Class
59c301c268f79cfde0a4c30a2c572a368db98da5Christian Maeder } deriving (Show, Eq)
4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian MaedernewClassInfo :: ClassInfo
c0ef189e724dfd960074248c97fb01dfa5842a5cChristian MaedernewClassInfo = ClassInfo [] Nothing
c0ef189e724dfd960074248c97fb01dfa5842a5cChristian Maeder-----------------------------------------------------------------------------
c0ef189e724dfd960074248c97fb01dfa5842a5cChristian Maedertype ClassMap = FiniteMap ClassId ClassInfo
c0ef189e724dfd960074248c97fb01dfa5842a5cChristian Maeder-----------------------------------------------------------------------------
c0ef189e724dfd960074248c97fb01dfa5842a5cChristian Maeder-----------------------------------------------------------------------------
c0ef189e724dfd960074248c97fb01dfa5842a5cChristian Maederdata GenKind = Free | Generated | Loose deriving (Show, Eq)
024621f43239cfe9629e35d35a8669fad7acbba2Christian Maederdata TypeDefn = NoTypeDefn
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder | Supertype TypeId Type Formula
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder | DatatypeDefn GenKind -- ...
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder | AliasTypeDefn PseudoType
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder | TypeVarDefn deriving (Show, Eq)
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maederdata TypeInfo = TypeInfo { typeKind :: Kind
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder , otherTypeKinds :: [Kind]
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder , superTypes :: [Type]
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder , typeDefn :: TypeDefn
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder } deriving (Show, Eq)
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian Maeder-----------------------------------------------------------------------------
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian Maedertype TypeMap = FiniteMap TypeId TypeInfo
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian Maeder-----------------------------------------------------------------------------
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian Maeder-- assumptions
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder-----------------------------------------------------------------------------
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maedertype Assumps = FiniteMap Id [TypeScheme]
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder-----------------------------------------------------------------------------
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian Maeder-----------------------------------------------------------------------------
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian Maederdata Env = Env { classMap :: ClassMap
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder , typeMap :: TypeMap
9e0472be46104307b974fe5079bf5cc9e94a1a96Christian Maeder , assumps :: Assumps
9e0472be46104307b974fe5079bf5cc9e94a1a96Christian Maeder , envDiags :: [Diagnosis]
9e0472be46104307b974fe5079bf5cc9e94a1a96Christian Maeder } deriving Show
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian MaederinitialEnv :: Env
9e0472be46104307b974fe5079bf5cc9e94a1a96Christian MaederinitialEnv = Env emptyFM emptyFM emptyFM []
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian MaederappendDiags :: [Diagnosis] -> State Env ()
9e0472be46104307b974fe5079bf5cc9e94a1a96Christian MaederappendDiags ds =
9e0472be46104307b974fe5079bf5cc9e94a1a96Christian Maeder if null ds then return () else
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder put $ e {envDiags = ds ++ envDiags e}
afa6848d579d235c9677e1ab477916df8e5ae11aChristian MaederaddDiag :: Diagnosis -> State Env ()
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian MaederaddDiag d = appendDiags [d]
792df0347edab377785d98c63e2be8e2ce0a8bdeChristian Maederindent :: Int -> ShowS -> ShowS
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maederindent i s = showString $ concat $
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder intersperse ('\n' : replicate i ' ') (lines $ s "")
d976ba42e9d48c289f9c73147669c7e57b7aa98eChristian Maeder-- ---------------------------------------------------------------------
986e0e9cf8c2358f455460b3fc75ce7c5dcf0973Christian MaedergetClassMap :: State Env ClassMap
6a7e00a968cb0f3f9ccae19ab47ef3636c7e79bfChristian MaedergetClassMap = gets classMap
88ece6e49930670e8fd3ee79c89a2e918d2fbd0cChristian MaederputClassMap :: ClassMap -> State Env ()
88ece6e49930670e8fd3ee79c89a2e918d2fbd0cChristian MaederputClassMap ce = do { e <- get; put e { classMap = ce } }
6a7e00a968cb0f3f9ccae19ab47ef3636c7e79bfChristian MaedergetTypeMap :: State Env TypeMap
6a7e00a968cb0f3f9ccae19ab47ef3636c7e79bfChristian MaedergetTypeMap = gets typeMap
72b9099aeec0762bae4546db3bc4b48721027bf4Christian MaederputTypeMap :: TypeMap -> State Env ()
6a7e00a968cb0f3f9ccae19ab47ef3636c7e79bfChristian MaederputTypeMap tk = do { e <- get; put e { typeMap = tk } }
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian MaedergetAssumps :: State Env Assumps
59c301c268f79cfde0a4c30a2c572a368db98da5Christian MaedergetAssumps = gets assumps
5553cf7e344c2b385a72e1244b419e9986042b8eChristian MaederputAssumps :: Assumps -> State Env ()
964d1dce6aa88a14e240a4f2fb81c539d2f834fcChristian MaederputAssumps as = do { e <- get; put e { assumps = as } }