ClassDecl.hs revision b4fbc96e05117839ca409f5f20f97b3ac872d1ed
0N/A{- |
0N/AModule : $Header$
0N/ACopyright : (c) Christian Maeder and Uni Bremen 2003
0N/ALicence : similar to LGPL, see HetCATS/LICENCE.txt or LIZENZ.txt
0N/A
0N/AMaintainer : maeder@tzi.de
0N/AStability : experimental
0N/APortability : portable
0N/A
0N/A analyse class decls
0N/A-}
0N/A
0N/Amodule HasCASL.ClassDecl where
0N/A
0N/Aimport HasCASL.As
0N/Aimport HasCASL.Le
0N/Aimport HasCASL.ClassAna
0N/Aimport HasCASL.VarDecl
0N/Aimport qualified Common.Lib.Map as Map
0N/Aimport qualified Common.Lib.Set as Set
0N/Aimport Common.Id
0N/Aimport Common.Lib.State
0N/Aimport Common.Result
0N/A
0N/A-- ---------------------------------------------------------------------------
0N/A-- analyse class decls
0N/A-- ---------------------------------------------------------------------------
0N/A
0N/AanaClassDecls :: ClassDecl -> State Env ClassDecl
0N/AanaClassDecls (ClassDecl cls k ps) =
0N/A do ak <- anaKind k
0N/A mapM_ (addClassDecl ak) cls
0N/A return $ ClassDecl cls ak ps
0N/A
0N/A-- ---------------------------------------------------------------------------
0N/A-- store class decls
0N/A-- ---------------------------------------------------------------------------
0N/A
0N/A-- | store a class map
0N/AputClassMap :: ClassMap -> State Env ()
0N/AputClassMap ce = do { e <- get; put e { classMap = ce } }
0N/A
0N/A-- | store a class
0N/AaddClassDecl :: Kind -> ClassId
0N/A -> State Env ()
0N/A-- check with merge
0N/AaddClassDecl kind ci =
0N/A if showId ci "" == "Type" then
0N/A do addDiags [mkDiag Error
0N/A "illegal universe class declaration" ci]
0N/A else do
0N/A cMap <- gets classMap
0N/A case Map.lookup ci cMap of
0N/A Nothing -> do putClassMap $ Map.insert ci
0N/A ClassInfo { classKinds = [kind] } cMap
0N/A Just info -> do
addDiags [mkDiag Warning "redeclared class" ci]
let superClasses = classKinds info
addDiags $ checkKinds ci kind $ head superClasses
if kind `elem` superClasses then
return ()
else if cyclicClassId ci kind then
addDiags [mkDiag Error "cyclic class" ci]
else putClassMap $ Map.insert ci info
{ classKinds = Set.toList $
mkIntersection
(kind:superClasses) } cMap
-- cycle check missing
showClassList :: [ClassId] -> ShowS
showClassList is = showParen (not $ isSingle is)
$ showSepList ("," ++) showId is
wrongClassDecl :: ClassId -> [Diagnosis]
wrongClassDecl ci =
[Diag Error
("inconsistent redefinition of '" ++ showId ci "'")
$ posOfId ci]