Symbol.hs revision 4fb19f237193a3bd6778f8aee3b6dd8da5856665
7abd0c58a5ce51db13f93de82407b2188d55d298Christian MaederModule : $Header$
81d182b21020b815887e9057959228546cf61b6bChristian MaederCopyright : (c) Christian Maeder and Uni Bremen 2003
14a1af9d9909dc47dc7fee6b0170b7ac0aef85daChristian MaederLicence : similar to LGPL, see HetCATS/LICENCE.txt or LIZENZ.txt
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian MaederMaintainer : hets@tzi.de
3f69b6948966979163bdfe8331c38833d5d90ecdChristian MaederStability : experimental
7abd0c58a5ce51db13f93de82407b2188d55d298Christian MaederPortability : portable
35597678f1c9da703de8d0b6b66ea63247ebe884Christian Maeder HasCASL analysed symbols of a signature
8197d0be8b81692f311ad5ca34e125e2cf9eecb8Christian Maederimport qualified Common.Lib.Map as Map
e8ffec0fa3d3061061bdc16e44247b9cf96b050fChristian Maederimport qualified Common.Lib.Set as Set
d42a01c4eb6892fe23ca9eff107bb29f4a229480Christian MaedercheckSymbols :: SymbolSet -> SymbolSet -> Result a -> Result a
b1bd8688a1ce545444792a307412711c2c61df5fChristian MaedercheckSymbols s1 s2 r =
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder let s = s1 Set.\\ s2 in
35597678f1c9da703de8d0b6b66ea63247ebe884Christian Maeder if Set.isEmpty s then r else
2ac1742771a267119f1d839054b5e45d0a468085Christian Maeder (text "unknown symbols: "
36c6cc568751e4235502cfee00ba7b597dae78dcChristian Maeder <+> printText s) $ posOfId $ symName $ Set.findMin s
35597678f1c9da703de8d0b6b66ea63247ebe884Christian MaederdependentSyms :: Symbol -> Env -> SymbolSet
81946e2b3f6dde6167f48769bd02c7a634736856Christian MaederdependentSyms sym sig =
36c6cc568751e4235502cfee00ba7b597dae78dcChristian Maeder if Set.member sym $ subSymsOf op then
2ac1742771a267119f1d839054b5e45d0a468085Christian Maeder Set.insert op se else se) Set.empty $ symOf sig
81946e2b3f6dde6167f48769bd02c7a634736856Christian MaederhideRelSymbol :: Symbol -> Env -> Env
b1bd8688a1ce545444792a307412711c2c61df5fChristian MaederhideRelSymbol sym sig =
81946e2b3f6dde6167f48769bd02c7a634736856Christian Maeder let depSyms = dependentSyms sym sig
36c6cc568751e4235502cfee00ba7b597dae78dcChristian Maeder relSyms = relatedSyms sig sym
14a1af9d9909dc47dc7fee6b0170b7ac0aef85daChristian Maeder if Set.isEmpty depSyms then hideSymbol sym sig
2ac1742771a267119f1d839054b5e45d0a468085Christian Maeder else if Set.isEmpty relSyms then
81946e2b3f6dde6167f48769bd02c7a634736856Christian Maeder hideSymbol sym $ Set.fold hideSymbol sig depSyms
81946e2b3f6dde6167f48769bd02c7a634736856Christian MaederhideSymbol :: Symbol -> Env -> Env
81946e2b3f6dde6167f48769bd02c7a634736856Christian MaederhideSymbol sym sig =
81946e2b3f6dde6167f48769bd02c7a634736856Christian Maeder let i = symName sym
36c6cc568751e4235502cfee00ba7b597dae78dcChristian Maeder tm = typeMap sig
36c6cc568751e4235502cfee00ba7b597dae78dcChristian Maeder as = assumps sig in
2ac1742771a267119f1d839054b5e45d0a468085Christian Maeder case symType sym of
ce7653c9c71e23bf04a5ec0ca5cb600c3738a909Christian Maeder ClassAsItemType _ -> sig
2ac1742771a267119f1d839054b5e45d0a468085Christian Maeder TypeAsItemType _ -> sig { typeMap =
ce7653c9c71e23bf04a5ec0ca5cb600c3738a909Christian Maeder OpAsItemType ot ->
2ac1742771a267119f1d839054b5e45d0a468085Christian Maeder let OpInfos os = Map.findWithDefault (OpInfos []) i as
ce7653c9c71e23bf04a5ec0ca5cb600c3738a909Christian Maeder rs = filter (not . isUnifiable tm 0 ot . opType) os
d48085f765fca838c1d972d2123601997174583dChristian Maeder in sig { assumps = if null rs then Map.delete i as
36c6cc568751e4235502cfee00ba7b597dae78dcChristian Maeder else Map.insert i (OpInfos rs) as }
b1bd8688a1ce545444792a307412711c2c61df5fChristian MaederplainHide :: SymbolSet -> Env -> Env
b1bd8688a1ce545444792a307412711c2c61df5fChristian MaederplainHide syms sigma =
b1bd8688a1ce545444792a307412711c2c61df5fChristian Maeder let (opSyms, otherSyms) = Set.partition (\ sy -> case symType sy of
b1bd8688a1ce545444792a307412711c2c61df5fChristian Maeder OpAsItemType _ -> True
b1bd8688a1ce545444792a307412711c2c61df5fChristian Maeder _ -> False) syms
b1bd8688a1ce545444792a307412711c2c61df5fChristian Maeder in Set.fold hideSymbol (Set.fold hideSymbol sigma otherSyms) opSyms
b1bd8688a1ce545444792a307412711c2c61df5fChristian Maeder-- | type ids within a type
b1bd8688a1ce545444792a307412711c2c61df5fChristian MaedersubSyms :: Env -> Type -> SymbolSet
b1bd8688a1ce545444792a307412711c2c61df5fChristian MaedersubSyms e t = case t of
b1bd8688a1ce545444792a307412711c2c61df5fChristian Maeder TypeName i k n ->
b1bd8688a1ce545444792a307412711c2c61df5fChristian Maeder if n == 0 then Set.single $ idToTypeSymbol e i k
b1bd8688a1ce545444792a307412711c2c61df5fChristian Maeder TypeAppl t1 t2 -> Set.union (subSyms e t1) (subSyms e t2)
b1bd8688a1ce545444792a307412711c2c61df5fChristian Maeder ExpandedType _ t1 -> subSyms e t1
b1bd8688a1ce545444792a307412711c2c61df5fChristian Maeder KindedType tk _ _ -> subSyms e tk
b1bd8688a1ce545444792a307412711c2c61df5fChristian Maeder LazyType tl _ -> subSyms e tl
b1bd8688a1ce545444792a307412711c2c61df5fChristian Maeder ProductType l _ -> Set.unions $ map (subSyms e) l
36c6cc568751e4235502cfee00ba7b597dae78dcChristian Maeder FunType t1 _ t2 _ -> Set.union (subSyms e t1) (subSyms e t2)
14a1af9d9909dc47dc7fee6b0170b7ac0aef85daChristian Maeder _ -> error ("subSyms: " ++ show t)
ce7653c9c71e23bf04a5ec0ca5cb600c3738a909Christian MaedersubSymsOf :: Symbol -> SymbolSet
2ac1742771a267119f1d839054b5e45d0a468085Christian MaedersubSymsOf sy = case symType sy of
14a1af9d9909dc47dc7fee6b0170b7ac0aef85daChristian Maeder OpAsItemType (TypeScheme _ ty _) -> subSyms (symEnv sy) ty
0f0aa53f11a0d1ab08c76428b9de73db5b17c977Christian MaederrelatedSyms :: Env -> Symbol -> SymbolSet
7c35990c03276d1e675ea6f4ba38f47081620d77Christian MaederrelatedSyms e sy =
7c35990c03276d1e675ea6f4ba38f47081620d77Christian Maeder case symType sy of
0f0aa53f11a0d1ab08c76428b9de73db5b17c977Christian Maeder TypeAsItemType _ -> Set.delete sy $
14a1af9d9909dc47dc7fee6b0170b7ac0aef85daChristian Maeder Set.image ( \ i -> sy { symName = i }) $
14a1af9d9909dc47dc7fee6b0170b7ac0aef85daChristian Maeder allRelIds (typeMap e) $ symName sy
36c6cc568751e4235502cfee00ba7b597dae78dcChristian MaedercloseSymbSet :: SymbolSet -> SymbolSet
36c6cc568751e4235502cfee00ba7b597dae78dcChristian MaedercloseSymbSet s = Set.unions (s : map subSymsOf (Set.toList s))
840b2a6f37ec58f3281da16fafbc4121462c856aChristian MaedersymOf :: Env -> SymbolSet
5ba383b1607c20c57e14324e72cee2c789436d5fChristian Maeder let classes = Map.foldWithKey ( \ i ks s ->
0f0aa53f11a0d1ab08c76428b9de73db5b17c977Christian Maeder Set.insert (idToClassSymbol sigma i $
5ba383b1607c20c57e14324e72cee2c789436d5fChristian Maeder Intersection (classKinds ks) []) s)
5ba383b1607c20c57e14324e72cee2c789436d5fChristian Maeder Set.empty $ classMap sigma
2ac1742771a267119f1d839054b5e45d0a468085Christian Maeder types = Map.foldWithKey ( \ i ti s ->
36c6cc568751e4235502cfee00ba7b597dae78dcChristian Maeder Set.insert (idToTypeSymbol sigma i $
36c6cc568751e4235502cfee00ba7b597dae78dcChristian Maeder typeKind ti) s)
14a1af9d9909dc47dc7fee6b0170b7ac0aef85daChristian Maeder classes $ typeMap sigma
2ac1742771a267119f1d839054b5e45d0a468085Christian Maeder ops = Map.foldWithKey ( \ i ts s0 ->
14a1af9d9909dc47dc7fee6b0170b7ac0aef85daChristian Maeder foldr ( \ t s1 ->
2ac1742771a267119f1d839054b5e45d0a468085Christian Maeder Set.insert (idToOpSymbol sigma i $
55ea7f4cb33abac6a8d539741e457cf686d1f26cChristian Maeder opType t) s1) s0 $ opInfos ts)
2118d66b6aa3c90458925019c9b2fb986e2b2aabChristian Maeder types $ assumps sigma