hets/HasCASL/ClassDecl.hs

	ClassDecl.hs revision 97018cf5fa25b494adffd7e9b4e87320dae6bf47
55cf6e01272ec475edea32aa9b7923de2d36cb42Christian Maeder{- |
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian MaederModule      :  $Header$
e9458b1a7a19a63aa4c179f9ab20f4d50681c168Jens ElknerCopyright   :  (c) Christian Maeder and Uni Bremen 2003
f278337cf46af220b2faecf4b47363fbb2c01dbaChristian MaederLicense     :  similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian Maeder
98890889ffb2e8f6f722b00e265a211f13b5a861Corneliu-Claudiu ProdescuMaintainer  :  maeder@tzi.de
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian MaederStability   :  experimental
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian MaederPortability :  portable
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian Maeder
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian Maeder   analyse class decls
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian Maeder-}
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian Maeder
f278337cf46af220b2faecf4b47363fbb2c01dbaChristian Maedermodule HasCASL.ClassDecl where
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian Maeder
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian Maederimport HasCASL.As
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian Maederimport HasCASL.Le
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroederimport HasCASL.ClassAna
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian Maederimport HasCASL.VarDecl
a209694d7694b93e56927c6aacc3f5b9366fdb8fChristian Maederimport qualified Common.Lib.Map as Map
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian Maederimport qualified Common.Lib.Set as Set
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian Maederimport Common.Id
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian Maederimport Common.Lib.State
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian Maederimport Common.Result
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian Maeder
a209694d7694b93e56927c6aacc3f5b9366fdb8fChristian Maeder-- ---------------------------------------------------------------------------
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian Maeder-- analyse class decls
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian Maeder-- ---------------------------------------------------------------------------
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian Maeder
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian MaederanaClassDecls :: ClassDecl -> State Env ClassDecl
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian MaederanaClassDecls (ClassDecl cls k ps) =
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian Maeder    do ak <- anaKind k
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian Maeder       mapM_ (addClassDecl ak) cls
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian Maeder       return $ ClassDecl cls ak ps
616b72452ce5a75ade1a11ccc2c9671b3444558eChristian Maeder
f278337cf46af220b2faecf4b47363fbb2c01dbaChristian Maeder-- ---------------------------------------------------------------------------
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian Maeder-- store class decls
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian Maeder-- ---------------------------------------------------------------------------
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian Maeder
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian Maeder-- | store a class map
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian MaederputClassMap :: ClassMap -> State Env ()
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian MaederputClassMap ce = do { e <- get; put e { classMap = ce } }
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian Maeder
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian Maeder-- | store a class
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederaddClassDecl :: Kind -> ClassId
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian Maeder             -> State Env ()
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian Maeder-- check with merge
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian MaederaddClassDecl kind ci =
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian Maeder    if showId ci "" == "Type" then
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian Maeder       do addDiags [mkDiag Error
a209694d7694b93e56927c6aacc3f5b9366fdb8fChristian Maeder                    "illegal universe class declaration" ci]
f278337cf46af220b2faecf4b47363fbb2c01dbaChristian Maeder    else do
f278337cf46af220b2faecf4b47363fbb2c01dbaChristian Maeder       cMap <- gets classMap
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder       case Map.lookup ci cMap of
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder            Nothing -> do putClassMap $ Map.insert ci
e4257c7b13b1122a1e6ec9e43753f3e565b88449Christian Maeder                              ClassInfo { classKinds = [kind] } cMap
aa074a906c39b63c7177040378c0073dbac4e3baChristian Maeder            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]