c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maeder{- |
e9458b1a7a19a63aa4c179f9ab20f4d50681c168Jens ElknerModule : ./CASL/Disambiguate.hs
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian MaederDescription : disambiguate all names
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian MaederCopyright : (c) Christian Maeder, DFKI GmbH 2008
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian MaederLicense : GPLv2 or higher, see LICENSE.txt
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maeder
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian MaederMaintainer : Christian.Maeder@dfki.de
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian MaederStability : provisional
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian MaederPortability : portable
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maeder
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian MaederDisambiguate all names that are not in the overload relation for CASL2OWL
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maeder-}
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maeder
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maedermodule CASL.Disambiguate where
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maeder
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maederimport CASL.AS_Basic_CASL
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maederimport CASL.Sign
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maederimport CASL.Morphism
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maederimport CASL.Overload
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maeder
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maederimport Common.Id
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maederimport qualified Common.Lib.MapSet as MapSet
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maederimport qualified Common.Lib.Rel as Rel
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maeder
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maederimport qualified Data.Map as Map
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maederimport qualified Data.Set as Set
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maeder
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian MaedermkOverloadedId :: Int -> Id -> Id
b34b0feedad284b086593c0488305fa2bf37aee8Christian MaedermkOverloadedId n i@(Id ts cs rs) = if n <= 1 then i else
b34b0feedad284b086593c0488305fa2bf37aee8Christian Maeder Id (ts ++ [mkSimpleId $ '_' : shows n "o"]) cs rs
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maeder
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian MaederdisambigSig :: Sign f e -> Morphism f e ()
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian MaederdisambigSig = disambigSigExt (\ _ _ _ _ -> extendedInfo) ()
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maeder
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maeder-- note that op-type keys are always partial!
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian MaederdisambigSigExt :: InducedSign f e m e -> m -> Sign f e -> Morphism f e m
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian MaederdisambigSigExt extInd extEm sig =
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maeder let ps = Map.map (Rel.partSet $ leqP sig) $ MapSet.toMap $ predMap sig
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maeder os = Map.map (Rel.partSet $ leqF sig) $ MapSet.toMap $ opMap sig
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maeder ss = sortSet sig
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maeder sMap = Set.fold (`Map.insert` 1) Map.empty ss
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maeder om = createOpMorMap $ disambOverloaded sMap mkPartial os
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maeder oMap = Map.foldWithKey (\ i ->
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maeder Map.insertWith (+) i . length) sMap os
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maeder pm = Map.map fst $ disambOverloaded oMap id ps
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maeder in (embedMorphism extEm sig $ inducedSignAux extInd Map.empty om pm extEm sig)
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maeder { op_map = om
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maeder , pred_map = pm }
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maeder
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian MaederdisambOverloaded :: Ord a => Map.Map Id Int
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maeder -> (a -> a)
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maeder -> Map.Map Id [Set.Set a]
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maeder -> Map.Map (Id, a) (Id, a)
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian MaederdisambOverloaded oMap g =
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maeder Map.foldWithKey (\ i l m ->
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maeder foldr (\ (s, n) m2 -> let j = mkOverloadedId n i in
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maeder Set.fold (\ t -> Map.insert (i, g t) (j, t)) m2 s) m
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maeder $ zip l [1 + Map.findWithDefault 0 i oMap ..])
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maeder Map.empty
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maeder
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian MaedercreateOpMorMap :: Map.Map (Id, OpType) (Id, OpType)
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian Maeder -> Map.Map (Id, OpType) (Id, OpKind)
c1cb6bd6e48671031b23730b3cd1dcc7593ecb30Christian MaedercreateOpMorMap = Map.map (\ (i, t) -> (i, opKind t))