Le.hs revision 7c57322afb6342e5cc8b1fdc96050b707407fc61
ea03c5d09694b4a966fbd19d46cfa5772648d95fChristian Maeder
ea03c5d09694b4a966fbd19d46cfa5772648d95fChristian Maeder{- HetCATS/HasCASL/Le.hs
ea03c5d09694b4a966fbd19d46cfa5772648d95fChristian Maeder $Id$
ea03c5d09694b4a966fbd19d46cfa5772648d95fChristian Maeder Authors: Christian Maeder
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder Year: 2002/2003
ea03c5d09694b4a966fbd19d46cfa5772648d95fChristian Maeder
ea03c5d09694b4a966fbd19d46cfa5772648d95fChristian Maeder abstract syntax after/during static analysis
ea03c5d09694b4a966fbd19d46cfa5772648d95fChristian Maeder-}
ea03c5d09694b4a966fbd19d46cfa5772648d95fChristian Maeder
502ed7ed7fecd10b6d0c83cdd48a244ec45e840aChristian Maedermodule Le where
502ed7ed7fecd10b6d0c83cdd48a244ec45e840aChristian Maeder
502ed7ed7fecd10b6d0c83cdd48a244ec45e840aChristian Maederimport Id
7f0e81a8fc10c17b13569f23474a0e3fbfa79e7dChristian Maederimport As
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maederimport MonadState
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maederimport FiniteMap
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maederimport List
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maederimport Result
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder
7c57322afb6342e5cc8b1fdc96050b707407fc61Christian Maederdata ClassInfo = ClassInfo { classId :: ClassId
7c57322afb6342e5cc8b1fdc96050b707407fc61Christian Maeder , superClasses :: [ClassId]
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder , classDefn :: Class
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder , instances :: [Qual Pred]
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder } deriving (Show, Eq)
502ed7ed7fecd10b6d0c83cdd48a244ec45e840aChristian Maeder
7c57322afb6342e5cc8b1fdc96050b707407fc61Christian MaedernewClassInfo :: ClassId -> ClassInfo
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian MaedernewClassInfo cid = ClassInfo cid [] (Intersection [] []) []
7f0e81a8fc10c17b13569f23474a0e3fbfa79e7dChristian Maeder
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder-----------------------------------------------------------------------------
ea03c5d09694b4a966fbd19d46cfa5772648d95fChristian Maeder
7c57322afb6342e5cc8b1fdc96050b707407fc61Christian Maedertype ClassMap = FiniteMap ClassId ClassInfo
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder-- transitiv super classes
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder-- PRE: all superclasses and defns must be defined in ClassEnv
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder-- and there must be no cycle!
7c57322afb6342e5cc8b1fdc96050b707407fc61Christian MaederallSuperClasses :: ClassMap -> ClassId -> [ClassId]
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian MaederallSuperClasses ce ci =
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder case lookupFM ce ci of
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder Just info -> nub $
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder ci: concatMap (allSuperClasses ce) (iclass $
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder classDefn info)
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder ++ concatMap (allSuperClasses ce) (superClasses info)
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder Nothing -> error "allSuperClasses"
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder
7c57322afb6342e5cc8b1fdc96050b707407fc61Christian MaederdefCEntry :: ClassMap -> ClassId -> [ClassId] -> Class -> ClassMap
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian MaederdefCEntry ce cid sups defn = addToFM ce cid
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder (newClassInfo cid) { superClasses = sups
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder , classDefn = defn }
502ed7ed7fecd10b6d0c83cdd48a244ec45e840aChristian Maeder
ea03c5d09694b4a966fbd19d46cfa5772648d95fChristian Maeder-----------------------------------------------------------------------------
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder-- assumptions
ea03c5d09694b4a966fbd19d46cfa5772648d95fChristian Maeder-----------------------------------------------------------------------------
502ed7ed7fecd10b6d0c83cdd48a244ec45e840aChristian Maeder
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maedertype Assumps = FiniteMap Id [TypeScheme]
502ed7ed7fecd10b6d0c83cdd48a244ec45e840aChristian Maeder
7c57322afb6342e5cc8b1fdc96050b707407fc61Christian Maedertype TypeKinds = FiniteMap TypeId [Kind]
7c57322afb6342e5cc8b1fdc96050b707407fc61Christian Maeder
7c57322afb6342e5cc8b1fdc96050b707407fc61Christian Maedertype ClassSyns = FiniteMap ClassId [ClassId]
502ed7ed7fecd10b6d0c83cdd48a244ec45e840aChristian Maeder
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder-----------------------------------------------------------------------------
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder-- local env
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder-----------------------------------------------------------------------------
502ed7ed7fecd10b6d0c83cdd48a244ec45e840aChristian Maeder
7c57322afb6342e5cc8b1fdc96050b707407fc61Christian Maederdata Env = Env { classMap :: ClassMap
7c57322afb6342e5cc8b1fdc96050b707407fc61Christian Maeder , classSyns :: ClassSyns
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder , typeKinds :: TypeKinds
7c57322afb6342e5cc8b1fdc96050b707407fc61Christian Maeder , typeVars :: [TypeId]
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder , assumps :: Assumps
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder , envDiags :: [Diagnosis]
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder } deriving Show
502ed7ed7fecd10b6d0c83cdd48a244ec45e840aChristian Maeder
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian MaederinitialEnv :: Env
7c57322afb6342e5cc8b1fdc96050b707407fc61Christian MaederinitialEnv = Env emptyFM emptyFM emptyFM [] emptyFM []
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian MaederappendDiags :: [Diagnosis] -> State Env ()
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian MaederappendDiags ds =
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder if null ds then return () else
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder do e <- get
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder put $ e {envDiags = ds ++ envDiags e}
502ed7ed7fecd10b6d0c83cdd48a244ec45e840aChristian Maeder
7c57322afb6342e5cc8b1fdc96050b707407fc61Christian MaedergetClassMap :: State Env ClassMap
7c57322afb6342e5cc8b1fdc96050b707407fc61Christian MaedergetClassMap = gets classMap
7c57322afb6342e5cc8b1fdc96050b707407fc61Christian Maeder
7c57322afb6342e5cc8b1fdc96050b707407fc61Christian MaederputClassMap :: ClassMap -> State Env ()
7c57322afb6342e5cc8b1fdc96050b707407fc61Christian MaederputClassMap ce = do { e <- get; put e { classMap = ce } }
7c57322afb6342e5cc8b1fdc96050b707407fc61Christian Maeder
7c57322afb6342e5cc8b1fdc96050b707407fc61Christian MaedergetClassSyns :: State Env ClassSyns
7c57322afb6342e5cc8b1fdc96050b707407fc61Christian MaedergetClassSyns = gets classSyns
3c72be149cf673945cbe07a04c336fb8f4d406a3Christian Maeder
7c57322afb6342e5cc8b1fdc96050b707407fc61Christian MaedergetClassEnv :: State Env (ClassMap, ClassSyns)
7c57322afb6342e5cc8b1fdc96050b707407fc61Christian MaedergetClassEnv = do cMap <- getClassMap
7c57322afb6342e5cc8b1fdc96050b707407fc61Christian Maeder cSyns <- getClassSyns
7c57322afb6342e5cc8b1fdc96050b707407fc61Christian Maeder return (cMap, cSyns)
3c72be149cf673945cbe07a04c336fb8f4d406a3Christian Maeder
7c57322afb6342e5cc8b1fdc96050b707407fc61Christian MaederputClassSyns :: ClassSyns -> State Env ()
7c57322afb6342e5cc8b1fdc96050b707407fc61Christian MaederputClassSyns ce = do { e <- get; put e { classSyns = ce } }
3c72be149cf673945cbe07a04c336fb8f4d406a3Christian Maeder
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian MaedergetTypeKinds :: State Env TypeKinds
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian MaedergetTypeKinds = gets typeKinds
3c72be149cf673945cbe07a04c336fb8f4d406a3Christian Maeder
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian MaederputTypeKinds :: TypeKinds -> State Env ()
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian MaederputTypeKinds tk = do { e <- get; put e { typeKinds = tk } }
502ed7ed7fecd10b6d0c83cdd48a244ec45e840aChristian Maeder
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian MaedergetAssumps :: State Env Assumps
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian MaedergetAssumps = gets assumps
502ed7ed7fecd10b6d0c83cdd48a244ec45e840aChristian Maeder
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian MaederputAssumps :: Assumps -> State Env ()
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian MaederputAssumps as = do { e <- get; put e { assumps = as } }
502ed7ed7fecd10b6d0c83cdd48a244ec45e840aChristian Maeder
7c57322afb6342e5cc8b1fdc96050b707407fc61Christian MaedergetTypeVars :: State Env [TypeId]
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian MaedergetTypeVars = gets typeVars
502ed7ed7fecd10b6d0c83cdd48a244ec45e840aChristian Maeder
7c57322afb6342e5cc8b1fdc96050b707407fc61Christian MaederputTypeVars :: [TypeId] -> State Env ()
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian MaederputTypeVars ts = do { e <- get; put e { typeVars = ts } }
502ed7ed7fecd10b6d0c83cdd48a244ec45e840aChristian Maeder
7c57322afb6342e5cc8b1fdc96050b707407fc61Christian MaederaddTypeVar :: TypeId -> State Env ()
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian MaederaddTypeVar t = do ts <- getTypeVars
7c57322afb6342e5cc8b1fdc96050b707407fc61Christian Maeder putTypeVars $ insert t ts