Morphism.hs revision 62599a910de0701b0f9461e534a43d5900131c55
bbae6e6ca0de7f2ffbb44d2c8da179f2b717237fChristian MaederModule : $Header$
81d182b21020b815887e9057959228546cf61b6bChristian MaederCopyright : (c) Christian Maeder and Uni Bremen 2002-2003
62ecb1e7f8fd9573eea8369657de12c7bf9f4f25Christian MaederLicence : All rights reserved.
bbae6e6ca0de7f2ffbb44d2c8da179f2b717237fChristian MaederMaintainer : hets@tzi.de
3f69b6948966979163bdfe8331c38833d5d90ecdChristian MaederStability : provisional
bbae6e6ca0de7f2ffbb44d2c8da179f2b717237fChristian MaederPortability : non-portable (deriving Typeable)
f3a94a197960e548ecd6520bb768cb0d547457bbChristian MaederMorphism on 'Env' (as for CASL)
722e8a91f69209ba0e99bf799c4989801d78cf16Christian Maederimport qualified Common.Lib.Map as Map
bbae6e6ca0de7f2ffbb44d2c8da179f2b717237fChristian Maederdata SymbolType = OpAsItemType TypeScheme
d4be42ac0e0c969e95f93bd858e3d14de35cc6aaChristian Maeder | TypeAsItemType Kind
ee9eddfa6953868fd6fbaff0d9ff68675a13675aChristian Maeder | ClassAsItemType
ad270004874ce1d0697fb30d7309f180553bb315Christian Maeder deriving (Show, Eq, Ord)
bbae6e6ca0de7f2ffbb44d2c8da179f2b717237fChristian Maederinstance Ord TypeScheme where
bbae6e6ca0de7f2ffbb44d2c8da179f2b717237fChristian Maeder t1 <= t2 = t1 == t2 || show t1 < show t2
5e26bfc8d7b18cf3a3fa7b919b4450fb669f37a5Christian Maederdata Symbol = Symbol {symName :: Id, symbType :: SymbolType}
ee9eddfa6953868fd6fbaff0d9ff68675a13675aChristian Maeder deriving (Show, Eq, Ord, Typeable)
5e26bfc8d7b18cf3a3fa7b919b4450fb669f37a5Christian Maederdata RawSymbol = ASymbol Symbol | AnID Id | AKindedId SymbKind Id
33a5d53a412ba0a4e5847f7538d6da2e22bd116cChristian Maeder deriving (Show, Eq, Ord, Typeable)
e774ab5733a1d673b123b0e63b14dd533e6fd4fcChristian MaederidToRaw :: Id -> RawSymbol
bbae6e6ca0de7f2ffbb44d2c8da179f2b717237fChristian MaederidToRaw x = AnID x
6e39bfd041946fce4982ac89834be73fd1bfb39aChristian MaedersymbTypeToKind :: SymbolType -> SymbKind
62ecb1e7f8fd9573eea8369657de12c7bf9f4f25Christian MaedersymbTypeToKind (OpAsItemType _) = SK_op
66b0bf1e3102c83f5728cf6cfecbd07444276a5fChristian MaedersymbTypeToKind (TypeAsItemType _) = SK_type
66b0bf1e3102c83f5728cf6cfecbd07444276a5fChristian MaedersymbTypeToKind ClassAsItemType = SK_class
42c01284bba8d7c8d995c8dfb96ace57d28ed1bcTill MossakowskisymbolToRaw :: Symbol -> RawSymbol
2bf209888545860dc77b9c3f2198d00eeab30d20Christian MaedersymbolToRaw (Symbol idt typ) = AKindedId (symbTypeToKind typ) idt
715ffaf874309df081d1e1cd8e05073fc1227729Christian MaederstatSymbMapItems :: [SymbMapItems] -> Result (Map.Map RawSymbol RawSymbol)
715ffaf874309df081d1e1cd8e05073fc1227729Christian MaederstatSymbMapItems sl = return (Map.fromList $ concat $ map s1 sl)
715ffaf874309df081d1e1cd8e05073fc1227729Christian Maeder s1 (SymbMapItems kind l _ _) = map (symbOrMapToRaw kind) l
2bf209888545860dc77b9c3f2198d00eeab30d20Christian MaedersymbOrMapToRaw :: SymbKind -> SymbOrMap -> (RawSymbol,RawSymbol)
60303deac79adb97a71e55a4d66f95f26688f05aChristian MaedersymbOrMapToRaw k (SymbOrMap s mt _) =
60303deac79adb97a71e55a4d66f95f26688f05aChristian Maeder (symbToRaw k s,
715ffaf874309df081d1e1cd8e05073fc1227729Christian Maeder symbToRaw k $ case mt of Nothing -> s
66b0bf1e3102c83f5728cf6cfecbd07444276a5fChristian MaederstatSymbItems :: [SymbItems] -> Result [RawSymbol]
4cf9b5b0484a15c0f071ef7898cdcc3a44a15429Christian MaederstatSymbItems sl =
66b0bf1e3102c83f5728cf6cfecbd07444276a5fChristian Maeder return (concat (map s1 sl))
66b0bf1e3102c83f5728cf6cfecbd07444276a5fChristian Maeder where s1 (SymbItems kind l _ _) = map (symbToRaw kind) l
60303deac79adb97a71e55a4d66f95f26688f05aChristian MaedersymbToRaw :: SymbKind -> Symb -> RawSymbol
66b0bf1e3102c83f5728cf6cfecbd07444276a5fChristian MaedersymbToRaw k (Symb idt _ _) = symbKindToRaw k idt
66b0bf1e3102c83f5728cf6cfecbd07444276a5fChristian MaedersymbKindToRaw :: SymbKind -> Id -> RawSymbol
715ffaf874309df081d1e1cd8e05073fc1227729Christian MaedersymbKindToRaw Implicit idt = AnID idt
60303deac79adb97a71e55a4d66f95f26688f05aChristian MaedersymbKindToRaw sk idt = AKindedId sk idt
ccf3de3d66b521a260e5c22d335c64a48e3f0195Christian MaedermatchSymb :: Symbol -> RawSymbol -> Bool
60303deac79adb97a71e55a4d66f95f26688f05aChristian MaedermatchSymb x (ASymbol y) = x==y
60303deac79adb97a71e55a4d66f95f26688f05aChristian MaedermatchSymb (Symbol idt _) (AnID di) = idt==di
60303deac79adb97a71e55a4d66f95f26688f05aChristian MaedermatchSymb (Symbol idt _) (AKindedId _ di) = idt==di
ccf3de3d66b521a260e5c22d335c64a48e3f0195Christian Maederdata Morphism = Morphism {msource,mtarget :: Env}
2a598ff0c1b7b51c33aee7029b43bc5cfcbea6b8Christian Maeder deriving (Eq, Show, Typeable)
d4be42ac0e0c969e95f93bd858e3d14de35cc6aaChristian MaedermkMorphism :: Env -> Env -> Morphism
2a598ff0c1b7b51c33aee7029b43bc5cfcbea6b8Christian MaedermkMorphism e1 e2 = Morphism e1 e2
bdce0d5f7e435df37670d3720929d97ab0043b6bChristian MaederideMor :: Env -> Morphism
715ffaf874309df081d1e1cd8e05073fc1227729Christian MaederideMor e = mkMorphism e e -- plus identity functions
715ffaf874309df081d1e1cd8e05073fc1227729Christian MaedercompMor :: Morphism -> Morphism -> Morphism
961fc5d08256957f68f245f2723085ced14a0a1fChristian MaedercompMor m1 m2 = Morphism (msource m1) (mtarget m2) -- plus composed functions
60303deac79adb97a71e55a4d66f95f26688f05aChristian MaederlegalEnv :: Env -> Bool
bdce0d5f7e435df37670d3720929d97ab0043b6bChristian MaederlegalEnv _ = True -- maybe a closure test?
bdce0d5f7e435df37670d3720929d97ab0043b6bChristian MaederlegalMor :: Morphism -> Bool
961fc5d08256957f68f245f2723085ced14a0a1fChristian MaederlegalMor m = legalEnv (msource m) && legalEnv (mtarget m) -- and what else?
715ffaf874309df081d1e1cd8e05073fc1227729Christian MaedermorphismUnion :: Morphism -> Morphism -> Result Morphism
bdce0d5f7e435df37670d3720929d97ab0043b6bChristian MaedermorphismUnion m1 m2 = do s <- merge (msource m1) $ msource m2
bdce0d5f7e435df37670d3720929d97ab0043b6bChristian Maeder t <- merge (mtarget m1) $ mtarget m2
bdce0d5f7e435df37670d3720929d97ab0043b6bChristian Maeder return $ mkMorphism s t