CASL2TopSort.hs revision e46298bf227cf09ea7bc0c94d01f915aaa543aee
c63ebf815c8a874525cf18670ad74847f7fc7b26Christian MaederModule : $Header$
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaederCopyright : (c) Klaus Luettich, Uni Bremen 2002-2004
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian MaederLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian MaederMaintainer : Christian.Maeder@dfki.de
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian MaederStability : provisional
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian MaederPortability : portable
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian MaederCoding out subsorting into unary predicates.
f4a2a20e49f41b2afa657e5e64d9e349c7faa091Christian Maeder New concept for proving Ontologies.
c9a7e6af169a2adfb92f42331cd578065ed83a2bChristian Maedermodule Comorphisms.CASL2TopSort (CASL2TopSort(..)) where
9dac90ec2be2a72e03893095461960d483fe2fc2Christian Maederimport qualified Common.Lib.Rel as Rel
c0c2380bced8159ff0297ece14eba948bd236471Christian Maederimport qualified Data.Map as Map
404166b9366552e9ec5abb87a37c76ec8a815fb7Klaus Luettichimport qualified Data.Set as Set
ad270004874ce1d0697fb30d7309f180553bb315Christian Maeder-- | The identity of the comorphism
4d56f2fa72e4aec20eb827c11ed49c8cbb7014bdChristian Maederdata CASL2TopSort = CASL2TopSort deriving Show
8ef75f1cc0437656bf622cec5ac9e8ea221da8f2Christian Maederinstance Language CASL2TopSort where
404166b9366552e9ec5abb87a37c76ec8a815fb7Klaus Luettich language_name CASL2TopSort = "CASL2PCFOLTopSort"
74eed04be26f549d2f7ca35c370e1c03879b28b1Christian Maederinstance Comorphism CASL2TopSort
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder CASL CASL_Sublogics
8d97ef4f234681b11bb5924bd4d03adef858d2d2Christian Maeder CASLBasicSpec CASLFORMULA SYMB_ITEMS SYMB_MAP_ITEMS
254df6f22d01eacf7c57b85729e0445747b630d9Christian Maeder Symbol RawSymbol ProofTree
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder CASL CASL_Sublogics
e593b89bfd4952698dc37feced21cefe869d87a2Christian Maeder CASLBasicSpec CASLFORMULA SYMB_ITEMS SYMB_MAP_ITEMS
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder Symbol RawSymbol ProofTree where
7cc09dd93962a2155c34d209d1d4cd7d7b838264Christian Maeder sourceLogic CASL2TopSort = CASL
1aee4aaddde105264c1faf394d88e302c05094ffChristian Maeder sourceSublogic CASL2TopSort = SL.top
1aee4aaddde105264c1faf394d88e302c05094ffChristian Maeder { sub_features = LocFilSub
51d769d55d88dfa88bdf54bee78d8fa85a2deba8Christian Maeder , which_logic = FOL
f041c9a6bda23de33a38490e35b831ae18d96b45Christian Maeder , cons_features = SortGen
7cc09dd93962a2155c34d209d1d4cd7d7b838264Christian Maeder { emptyMapping = True
51d769d55d88dfa88bdf54bee78d8fa85a2deba8Christian Maeder , onlyInjConstrs = True }}
1aee4aaddde105264c1faf394d88e302c05094ffChristian Maeder targetLogic CASL2TopSort = CASL
1aee4aaddde105264c1faf394d88e302c05094ffChristian Maeder mapSublogic CASL2TopSort sub =
c3053d57f642ca507cdf79512e604437c4546cb9Christian Maeder if sub `isSubElem` sourceSublogic CASL2TopSort
f4a2a20e49f41b2afa657e5e64d9e349c7faa091Christian Maeder sub { sub_features = NoSub -- subsorting is coded out
f4a2a20e49f41b2afa657e5e64d9e349c7faa091Christian Maeder , cons_features = NoSortGen -- special Sort_gen_ax is coded out
dcbd32289a7bdf1e6edd06c6ab0698c6a9dbf37aChristian Maeder , which_logic = max Horn (which_logic sub)
d0279930f87bf39843e0bd2992a4789322662144Christian Maeder , has_eq = True -- was in the original targetLogic
8be81a0578b59f08641da7fad1479e1f9e83c6e9Kristina Sojakova -- may be avoided through predications of sort-preds
1aee4aaddde105264c1faf394d88e302c05094ffChristian Maeder -- with the result terms of functions instead of formulas like:
8b767d09a78927b111f5596fdff9ca7d2c1a439fChristian Maeder -- forall x : T . bot = x => a(x)
8b767d09a78927b111f5596fdff9ca7d2c1a439fChristian Maeder -- better: . a(bot)
8b767d09a78927b111f5596fdff9ca7d2c1a439fChristian Maeder , has_pred = True }
8b767d09a78927b111f5596fdff9ca7d2c1a439fChristian Maeder -- subsorting is coded out and
8b767d09a78927b111f5596fdff9ca7d2c1a439fChristian Maeder -- special Sort_gen_ax are coded out
d54cd08a4cfa26256c38d8ed12c343adbfe1a0e3Christian Maeder map_theory CASL2TopSort = mkTheoryMapping transSig transSen
23b4e542dca35852f58d1fb3f7d9078c1de5ab06Christian Maeder map_morphism CASL2TopSort mor = do
23b4e542dca35852f58d1fb3f7d9078c1de5ab06Christian Maeder let trSig = fmap fst . transSig
8cacad2a09782249243b80985f28e9387019fe40Christian Maeder sigSour <- trSig $ msource mor
363939beade943a02b31004cea09dec34fa8a6d9Christian Maeder sigTarg <- trSig $ mtarget mor
363939beade943a02b31004cea09dec34fa8a6d9Christian Maeder { msource = sigSour
8a28707e9155465c6f2236a06eac6580a65c7025Christian Maeder , mtarget = sigTarg }
f04e8f3ff56405901be968fd4c6e9769239f1a9bKlaus Luettich map_sentence CASL2TopSort = transSen
797ccd67cb8ae127be097cd43448801b673e3b69Christian Maeder map_symbol CASL2TopSort _ = Set.singleton . id
797ccd67cb8ae127be097cd43448801b673e3b69Christian Maeder has_model_expansion CASL2TopSort = True
f1541d4a151dbd08002dbd14e7eb1d5dde253689Christian Maederdata PredInfo = PredInfo { topSortPI :: SORT
498aa48bdb931ab50990d3b74318a5db2312186cChristian Maeder , directSuperSortsPI :: Set.Set SORT
f1541d4a151dbd08002dbd14e7eb1d5dde253689Christian Maeder , predicatePI :: PRED_NAME
6dc9bc98d0854fe2e3dd3bfc4275096a0c28ee1cChristian Maeder } deriving (Show, Ord, Eq)
6dc9bc98d0854fe2e3dd3bfc4275096a0c28ee1cChristian Maedertype SubSortMap = Map.Map SORT PredInfo
61fa0ac06ede811c7aad54ec4c4202346727368eChristian MaedergenerateSubSortMap :: Rel.Rel SORT
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder -> Result SubSortMap
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian MaedergenerateSubSortMap sortRels pMap =
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder let disAmbMap = Map.map disAmbPred
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder disAmbPred v = if Map.member (predicatePI v) pMap
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder then disAmbPred' (1::Int) v'
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian Maeder where v' = add "_s" v
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian Maeder disAmbPred' x v1 =
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian Maeder if Map.member (predicatePI v1) pMap
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder then disAmbPred' (x + 1) (add (show x) v')
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder add s v1 = v1 {predicatePI =
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian Maeder case predicatePI v1 of
a5e5b8c3e5c11177e5034ef2423813a5d28979edChristian Maeder Id ts is ps ->
bc8cbf12aa172bf5673b92a9e7a0151d4aa4c315Christian Maeder assert (not (null ts))
2d130d212db7208777ca896a7ecad619a8944971Christian Maeder (Id (init ts ++
2d130d212db7208777ca896a7ecad619a8944971Christian Maeder [(last ts) {tokStr =
51d769d55d88dfa88bdf54bee78d8fa85a2deba8Christian Maeder tokStr (last ts)++s}
2d130d212db7208777ca896a7ecad619a8944971Christian Maeder Rel.partSet (\ x y -> Rel.member x y sortRels &&
2d130d212db7208777ca896a7ecad619a8944971Christian Maeder toPredInfo k e =
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian Maeder let ts = case filter (\pts -> Rel.member k pts sortRels)
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian Maeder _ -> error "CASL2TopSort.generateSubSortMap.toPredInfo"
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian Maeder in PredInfo { topSortPI = ts
4017ebc0f692820736d796af3110c3b3018c108aChristian Maeder , directSuperSortsPI = Set.difference e mR
a9b59eb2ce961014974276cdae0e9df4419bd212Christian Maeder , predicatePI = k }
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian Maeder initMap = Map.filterWithKey (\k _ -> not (Set.member k mR))
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian Maeder in return (disAmbMap initMap)
a3c6d8e0670bf2aa71bc8e2a3b1f45d56dd65e4cChristian Maeder-- | Finds Top-sort(s) and transforms for each top-sort all subsorts
dc679edd4ca027663212afdf00926ae2ce19b555Christian Maeder-- into unary predicates. All predicates typed with subsorts are now
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder-- typed with the top-sort and axioms reflecting the typing are
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maeder-- generated. The operations are treated analogous. Axioms are
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder-- generated that each generated unary predicate must hold on at least
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maeder-- one element of the top-sort.
ca074a78b8dcccbb8c419586787882f98d0c6163Christian MaedertransSig :: Sign () e -> Result (Sign () e, [Named (FORMULA ())])
4017ebc0f692820736d796af3110c3b3018c108aChristian MaedertransSig sig = if Rel.null sortRels then
b568982efd0997d877286faa592d81b03c8c67b8Christian Maeder hint (sig, [])
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maeder "CASL2TopSort.transSig: Signature is unchanged (no subsorting present)"
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder subSortMap <- generateSubSortMap sortRels (predMap sig)
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder let (dias2, newPredMap) = Map.mapAccum (\ ds (un, ds1) -> (ds ++ ds1, un))
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder [] $ Map.unionWithKey repError (transPredMap subSortMap
f2f9df2e17e70674f0bf426ed1763c973ee4cde0Christian Maeder $ predMap sig) $ newPreds subSortMap
d946c1bfdd7d58aa7c023efe864d5999eb44a61bChristian Maeder Result dias2 $ Just ()
d946c1bfdd7d58aa7c023efe864d5999eb44a61bChristian Maeder axs <- generateAxioms subSortMap (predMap sig) (opMap sig)
d946c1bfdd7d58aa7c023efe864d5999eb44a61bChristian Maeder { sortSet = Set.fromList (map topSortPI $ Map.elems subSortMap)
d946c1bfdd7d58aa7c023efe864d5999eb44a61bChristian Maeder `Set.union` (sortSet sig `Set.difference` Map.keysSet subSortMap)
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder , opMap = transOpMap subSortMap (opMap sig)
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder , assocOps= transOpMap subSortMap (assocOps sig)
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder , predMap = newPredMap
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maeder }, axs ++ symmetryAxioms subSortMap sortRels)
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maeder where sortRels = Rel.transClosure $ sortRel sig
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder repError k (v1, d1) (v2, d2) =
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maeder ("CASL2TopSort.transSig: generating " ++
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder "overloading: Predicate " ++ show k ++
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder " gets additional type(s): " ++ show v2) nullRange
d946c1bfdd7d58aa7c023efe864d5999eb44a61bChristian Maeder foldr (\ pI -> Map.insert (predicatePI pI)
363939beade943a02b31004cea09dec34fa8a6d9Christian Maeder (PredType [topSortPI pI]),[]))
eb74267cf39e4e95f9eeb5c765f4c8dac33971b4Christian MaedertransPredMap :: SubSortMap -> Map.Map PRED_NAME (Set.Set PredType)
e4f4d096e5e6d60dd91c746d0e833d0ac7a29c50Christian Maeder -> Map.Map PRED_NAME (Set.Set PredType, [Diagnosis])
61fa0ac06ede811c7aad54ec4c4202346727368eChristian MaedertransPredMap subSortMap = Map.map (\ s -> (Set.map transType s, []))
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder where transType t = t
f1541d4a151dbd08002dbd14e7eb1d5dde253689Christian Maeder { predArgs = map (\ s -> maybe s topSortPI
363939beade943a02b31004cea09dec34fa8a6d9Christian Maeder $ Map.lookup s subSortMap) $ predArgs t }
c9a7e6af169a2adfb92f42331cd578065ed83a2bChristian MaedertransOpMap :: SubSortMap -> Map.Map OP_NAME (Set.Set OpType)
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaedertransOpMap subSortMap = Map.map (tidySet . Set.map transType)
c9a7e6af169a2adfb92f42331cd578065ed83a2bChristian Maeder where tidySet s = Set.fold joinPartial s s
c9a7e6af169a2adfb92f42331cd578065ed83a2bChristian Maeder where joinPartial t@(OpType {opKind = Partial})
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder | Set.member t {opKind = Total} s = Set.delete t
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder | otherwise = id
0e5b095a19790411e5352fa7cf57cb0388e70472Christian Maeder joinPartial _ = id
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder transType t =
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder t { opArgs = map lkp (opArgs t)
c9a7e6af169a2adfb92f42331cd578065ed83a2bChristian Maeder , opRes = lkp (opRes t)}
c9a7e6af169a2adfb92f42331cd578065ed83a2bChristian Maeder lkp s = maybe s topSortPI (Map.lookup s subSortMap)
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian MaederprocOpMapping :: SubSortMap
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder -> OP_NAME -> Set.Set OpType
42b12fba6830ada5057949f825fc27edf5574e5fChristian Maeder -> Result [Named (FORMULA ())] -> Result [Named (FORMULA ())]
42b12fba6830ada5057949f825fc27edf5574e5fChristian MaederprocOpMapping subSortMap opName set r = do
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder profMap <- mkProfMapOp opName subSortMap set
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian Maeder return $ al ++ Map.foldWithKey procProfMapOpMapping [] profMap
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder procProfMapOpMapping :: [SORT] -> (OpKind, Set.Set [Maybe PRED_NAME])
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder -> [Named (FORMULA ())] -> [Named (FORMULA ())]
93f5b72fdb9ee734caa750b43dd79bbb590dcd73Christian Maeder procProfMapOpMapping sl (kind, spl) = genArgRest
93f5b72fdb9ee734caa750b43dd79bbb590dcd73Christian Maeder (genSenName "o" opName $ length sl) (genOpEquation kind opName) sl spl
93f5b72fdb9ee734caa750b43dd79bbb590dcd73Christian MaedermkQualPred :: PRED_NAME -> SORT -> PRED_SYMB
328a85c807f2a95c3f147d10b05927eaf862ebebChristian MaedermkQualPred symS ts = Qual_pred_name symS (Pred_type [ts] nullRange) nullRange
06dd4e7c29f33f6122a910719e3bd9062256e397Andy GimblettsymmetryAxioms :: SubSortMap -> Rel.Rel SORT -> [Named (FORMULA ())]
254df6f22d01eacf7c57b85729e0445747b630d9Christian MaedersymmetryAxioms ssMap sortRels =
5b818f10e11fc79def1fdd5c8a080d64a6438d87Christian Maeder let symSets = Rel.sccOfClosure sortRels
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder symTopSorts = not . Set.null . Set.intersection mR
819e29dba060687cf391e444e0f6ff88c1908cc3Christian Maeder toAxioms symSet = map (\ s ->
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder let ts = lkupTop ssMap s
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder Just symS = lkupPredName ssMap s
a14767aeac3e78ed100f5b75e210ba563ee10dbaChristian Maeder psy = mkQualPred symS ts
a14767aeac3e78ed100f5b75e210ba563ee10dbaChristian Maeder vd = mkVarDeclStr "x" ts
8b0f493ae42bad8b94918cc0957f1af57096cda4Felix Reckers vt = toQualVar vd
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder in makeNamed (show ts ++ "_symmetric_with_" ++ show symS)
9e748851c150e1022fb952bab3315e869aaf0214Christian Maeder $ mkForall [vd] (Predication psy [vt] nullRange) nullRange
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder in concatMap toAxioms (filter symTopSorts symSets)
383aa66e5142365fe9b1f88b18c1da5b27cc8c04Christian MaedergenerateAxioms :: SubSortMap -> Map.Map PRED_NAME (Set.Set PredType)
383aa66e5142365fe9b1f88b18c1da5b27cc8c04Christian Maeder -> Result [Named (FORMULA ())]
383aa66e5142365fe9b1f88b18c1da5b27cc8c04Christian MaedergenerateAxioms subSortMap pMap oMap = do
383aa66e5142365fe9b1f88b18c1da5b27cc8c04Christian Maeder -- generate argument restrictions for operations
383aa66e5142365fe9b1f88b18c1da5b27cc8c04Christian Maeder axs <- Map.foldWithKey (procOpMapping subSortMap) (return []) oMap
a14767aeac3e78ed100f5b75e210ba563ee10dbaChristian Maeder return $ hi_axs ++ reverse p_axs ++ reverse axs
a14767aeac3e78ed100f5b75e210ba563ee10dbaChristian Maeder where p_axs =
a14767aeac3e78ed100f5b75e210ba563ee10dbaChristian Maeder -- generate argument restrictions for predicates
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder (\ sl -> genArgRest
697e63e30aa3c309a1ef1f9357745111f8dfc5a9Christian Maeder (genSenName "p" pName $ length sl)
697e63e30aa3c309a1ef1f9357745111f8dfc5a9Christian Maeder (genPredication pName)
f9e0b18852b238ddb649d341194e05d7200d1bbeChristian Maeder [] (mkProfMapPred subSortMap set)))
819e29dba060687cf391e444e0f6ff88c1908cc3Christian Maeder -- generate subclass_of axioms derived from subsorts
819e29dba060687cf391e444e0f6ff88c1908cc3Christian Maeder -- and non-emptyness axioms
819e29dba060687cf391e444e0f6ff88c1908cc3Christian Maeder concatMap (\ prdInf ->
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder let ts = topSortPI prdInf
254df6f22d01eacf7c57b85729e0445747b630d9Christian Maeder subS = predicatePI prdInf
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder set = directSuperSortsPI prdInf
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder maybe (error ("CASL2TopSort: genAxioms:" ++
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder " impossible happend: " ++ show s))
254df6f22d01eacf7c57b85729e0445747b630d9Christian Maeder predicatePI $ Map.lookup s subSortMap)
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder x = mkVarDeclStr "x" ts
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder mkPredf sS = Predication (mkQualPred sS ts) [toQualVar x]
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder in makeNamed (show subS ++ "_non_empty")
ac34194a668399bb8ef238da77c3a09e93fb253bChristian Maeder (Quantification Existential [x] (mkPredf subS)
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder : map (\ supS ->
1842453990fed8a1bd7a5ac792d7982c1d2bfcd5Christian Maeder makeNamed (show subS ++ "_subclassOf_" ++ show supS)
254df6f22d01eacf7c57b85729e0445747b630d9Christian Maeder $ mkForall [x]
1842453990fed8a1bd7a5ac792d7982c1d2bfcd5Christian Maeder (mkImpl (mkPredf subS) $ mkPredf supS)
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder nullRange) supPreds
61fa0ac06ede811c7aad54ec4c4202346727368eChristian MaedermkProfMapPred :: SubSortMap -> Set.Set PredType
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder -> Map.Map [SORT] (Set.Set [Maybe PRED_NAME])
01e278bdd7dce13b9303ed3d79683d83c89d09f9Liam O'ReillymkProfMapPred ssm = Set.fold seperate Map.empty
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder where seperate pt = Rel.setInsert (pt2topSorts pt) (pt2preds pt)
5ad5dffe06818a13e1632b1119fbca7881085fc1Dominik Luecke pt2topSorts = map (lkupTop ssm) . predArgs
8c812cd83569e973f10cf69a342424ceabc07af9Christian Maeder pt2preds = map (lkupPredName ssm) . predArgs
8c812cd83569e973f10cf69a342424ceabc07af9Christian MaedermkProfMapOp :: OP_NAME -> SubSortMap -> Set.Set OpType
05a206508bc898f87fe6ab6e069814df3c29d303Dominik Luecke -> Result (Map.Map [SORT] (OpKind, Set.Set [Maybe PRED_NAME]))
05a206508bc898f87fe6ab6e069814df3c29d303Dominik LueckemkProfMapOp opName ssm = Set.fold seperate (return Map.empty)
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder where seperate ot r = do
d54cd08a4cfa26256c38d8ed12c343adbfe1a0e3Christian Maeder Result dias' $ Just ()
d54cd08a4cfa26256c38d8ed12c343adbfe1a0e3Christian Maeder return $ Map.insertWith (\ (k1, s1) (k2, s2) ->
3b06e23643a9f65390cb8c1caabe83fa7e87a708Till Mossakowski (min k1 k2, Set.union s1 s2))
b1f59a4ea7c96f4c03a4d7cfcb9c5e66871cfbbbChristian Maeder (pt2topSorts joinedList)
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder (fKind, Set.singleton $ pt2preds joinedList) mp
8c812cd83569e973f10cf69a342424ceabc07af9Christian Maeder where joinedList = opArgs ot ++ [opRes ot]
0b349288edfa50fdf38fda1a14e1562d03f92574Christian Maeder fKind = opKind ot
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly dias' = [ Diag Warning
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder ("Please, check if operation \"" ++
1b3a2f98d1cd01fc9e0591f69507e20526727559Dominik Luecke show opName ++
f04e8f3ff56405901be968fd4c6e9769239f1a9bKlaus Luettich "\" is still partial as intended,\
247cc88aa55d0a7b6831767cd593ea885c6747a0Christian Maeder \ since a joining of types could\
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder \ have made it total!!")
ea3bff3e547a1ac714d4db39c5efef95e02b2e7dChristian Maeder | fKind == Partial ]
abf2487c3aece95c371ea89ac64319370dcb6483Klaus Luettich pt2topSorts = map (lkupTop ssm)
23b4e542dca35852f58d1fb3f7d9078c1de5ab06Christian Maeder pt2preds = map (lkupPredName ssm)
23b4e542dca35852f58d1fb3f7d9078c1de5ab06Christian MaederlkupTop :: SubSortMap -> SORT -> SORT
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaederlkupTop ssm s = maybe s topSortPI (Map.lookup s ssm)
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaederlkupPredName :: SubSortMap -> SORT -> Maybe PRED_NAME
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaederlkupPredName ssm s = maybe Nothing (Just . predicatePI) (Map.lookup s ssm)
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaedergenArgRest :: String
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder -> ([VAR_DECL] -> FORMULA f)
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder -- ^ generates from a list of variables
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder -- either the predication or function equation
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder -> [SORT] -> (Set.Set [Maybe PRED_NAME])
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder -> [Named (FORMULA f)] -> [Named (FORMULA f)]
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaedergenArgRest sen_name genProp sl spl fs =
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder let vars = genVars sl
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder mquant = genQuantification (genProp vars) vars spl
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder in maybe fs (\ quant -> mapNamed (const quant) (makeNamed "" sen_name)
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaedergenPredication :: PRED_NAME -> [VAR_DECL] -> FORMULA f
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaedergenPredication pName vars =
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder genPredAppl pName (map (\ (Var_decl _ s _) -> s) vars) $ map toQualVar vars
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder-- | generate a predication with qualified pred name
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaedergenPredAppl :: PRED_NAME -> [SORT] -> [TERM f] -> FORMULA f
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaedergenPredAppl pName sl terms = Predication (Qual_pred_name pName
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder (Pred_type sl nullRange) nullRange) terms nullRange
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaedergenOpEquation :: OpKind -> OP_NAME -> [VAR_DECL] -> FORMULA f
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaedergenOpEquation kind opName vars =
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Strong_equation opTerm resTerm nullRange
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder where terms = map toQualVar vars
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder opTerm = mkAppl (Qual_op_name opName opType nullRange) argTerms
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder opType = Op_type kind argSorts resSort nullRange
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder argTerms = init terms
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder resTerm = last terms
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder argSorts = map sortOfTerm argTerms
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder resSort = sortOfTerm resTerm
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaedergenVars :: [SORT] -> [VAR_DECL]
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaedergenVars = zipWith mkVarDeclStr varSymbs
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder where varSymbs =
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder map (: []) "xyzuwv" ++ map (\ i -> 'v' : show i) [(1::Int)..]
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaedergenSenName :: Show a => String -> a -> Int -> String
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaedergenSenName suff symbName arity =
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder "arg_rest_" ++ show symbName ++ '_' : suff ++ '_' : show arity
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaedergenQuantification :: FORMULA f -- ^ either the predication or
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder -- function equation
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder -> [VAR_DECL] -- ^ Qual_vars
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder -> (Set.Set [Maybe PRED_NAME])
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder -> Maybe (FORMULA f)
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaedergenQuantification prop vars spl = do
23b4e542dca35852f58d1fb3f7d9078c1de5ab06Christian Maeder dis <- genDisjunction vars spl
23b4e542dca35852f58d1fb3f7d9078c1de5ab06Christian Maeder return $ mkForall vars
23b4e542dca35852f58d1fb3f7d9078c1de5ab06Christian Maeder (mkImpl prop dis) nullRange
c70ef4c3b3a62764f715510c9fd67dde3acfe454Christian MaedergenDisjunction :: [VAR_DECL] -> Set.Set [Maybe PRED_NAME] -> Maybe (FORMULA f)
61fa0ac06ede811c7aad54ec4c4202346727368eChristian MaedergenDisjunction vars spn
8b0f493ae42bad8b94918cc0957f1af57096cda4Felix Reckers case disjs of
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder [] -> Nothing
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder [x] -> Just x
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder _ -> error "CASL2TopSort.genDisjunction: this cannot happen"
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder | null disjs = Nothing
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder | otherwise = Just (Disjunction disjs nullRange)
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder where disjs = foldl genConjunction [] (Set.toList spn)
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder genConjunction acc pns
b9b960bc75e34658e70c4a0231dbc6a6e7373f2dChristian Maeder | null conjs = acc
18a4d5cb6828f080db9c5f9551785c5151027271Christian Maeder | otherwise = Conjunction (reverse conjs) nullRange : acc
846d851fc0c2c49e949763cd3407634ba0f726c0Christian Maeder where conjs = foldl genPred [] (zip vars pns)
9e748851c150e1022fb952bab3315e869aaf0214Christian Maeder genPred acc (v, mpn) = maybe acc
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder (\ pn -> genPredication pn [v] : acc) mpn
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder-- | Each membership test of a subsort is transformed to a predication
43b4c41fbb07705c9df321221ab9cb9832460407Christian Maeder-- of the corresponding unary predicate. Variables quantified over a
8c812cd83569e973f10cf69a342424ceabc07af9Christian Maeder-- subsort yield a premise to the quantified formula that the
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder-- corresponding predicate holds. All typings are adjusted according
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder-- to the subsortmap and sort generation constraints are translated to
4e9e95ba35a68f3c767bc0b23ebf9e904e442517Christian Maeder-- disjointness axioms.
4e9e95ba35a68f3c767bc0b23ebf9e904e442517Christian MaedertransSen :: (Show f) => Sign f e -> FORMULA f -> Result (FORMULA f)
ff2cced55f8db4fe7b72b46f7852018e1e3283e4Christian MaedertransSen sig f = let sortRels = Rel.transClosure $ sortRel sig in
4e9e95ba35a68f3c767bc0b23ebf9e904e442517Christian Maeder if Rel.null sortRels then
4e9e95ba35a68f3c767bc0b23ebf9e904e442517Christian Maeder Result [Diag Hint
4e9e95ba35a68f3c767bc0b23ebf9e904e442517Christian Maeder "CASL2TopSort.transSen: Sentence is unchanged (no subsorting present)"
4e9e95ba35a68f3c767bc0b23ebf9e904e442517Christian Maeder nullRange ] (Just f)
4e9e95ba35a68f3c767bc0b23ebf9e904e442517Christian Maeder ssm <- generateSubSortMap sortRels (predMap sig)
4e9e95ba35a68f3c767bc0b23ebf9e904e442517Christian MaedermapSen :: SubSortMap -> FORMULA f -> Result (FORMULA f)
a6c557605b327b033d881e74cc9f3cdbe3713b47Christian MaedermapSen ssMap f =
4e9e95ba35a68f3c767bc0b23ebf9e904e442517Christian Maeder Sort_gen_ax cs _ ->
4e9e95ba35a68f3c767bc0b23ebf9e904e442517Christian Maeder genEitherAxiom ssMap cs
4e9e95ba35a68f3c767bc0b23ebf9e904e442517Christian Maeder _ -> return $ mapSen1 ssMap f
a4415cf57b9d9c39b61d246b3b12b204b126232eChristian MaedermapSen1 :: SubSortMap -> FORMULA f -> FORMULA f
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian MaedermapSen1 subSortMap f =
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian Maeder Conjunction fl pl -> Conjunction (map (mapSen1 subSortMap) fl) pl
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder Disjunction fl pl -> Disjunction (map (mapSen1 subSortMap) fl) pl
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder Implication f1 f2 b pl ->
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder Implication (mapSen1 subSortMap f1) (mapSen1 subSortMap f2) b pl
8d401657e07a01e10400265f508f75353a9fba4cChristian Maeder Equivalence f1 f2 pl ->
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder Equivalence (mapSen1 subSortMap f1) (mapSen1 subSortMap f2) pl
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Negation f1 pl -> Negation (mapSen1 subSortMap f1) pl
6bf24e5eb644064ad650eb3fd9774483fccbf601Christian Maeder tr@(True_atom _) -> tr
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder fa@(False_atom _) -> fa
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder Quantification q vdl f1 pl ->
f04e8f3ff56405901be968fd4c6e9769239f1a9bKlaus Luettich Quantification q (map updateVarDecls vdl)
e8db9a65830cf71504e33c6f441a67b4d184a3caChristian Maeder (relativize q vdl (mapSen1 subSortMap f1)) pl
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder Membership t s pl ->
1f8a7f8343f7df719768d2b1d7e3077ee291a1caChristian Maeder let t' = mapTerm subSortMap t
1f8a7f8343f7df719768d2b1d7e3077ee291a1caChristian Maeder in maybe (Membership t' s pl)
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder (\pn -> genPredAppl pn [lkupTop subSortMap s]
dbe752ee940baae7f9f231f29c62284bb0f90a25Christian Maeder (lkupPredName subSortMap s)
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder Existl_equation t1 t2 pl ->
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder Existl_equation (mapTerm subSortMap t1) (mapTerm subSortMap t2) pl
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder Strong_equation t1 t2 pl ->
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich Strong_equation (mapTerm subSortMap t1) (mapTerm subSortMap t2) pl
1aee4aaddde105264c1faf394d88e302c05094ffChristian Maeder Definedness t pl ->
368c26b8ad68a4b2c42963626087667000c2eebfChristian Maeder Definedness (mapTerm subSortMap t) pl
368c26b8ad68a4b2c42963626087667000c2eebfChristian Maeder Predication psy tl pl ->
368c26b8ad68a4b2c42963626087667000c2eebfChristian Maeder Predication (updatePRED_SYMB psy) (map (mapTerm subSortMap) tl) pl
f443a57f2a8e0ca3daa7431b0c89a18ba52c337aChristian Maeder ExtFORMULA f1 -> ExtFORMULA f1 -- ExtFORMULA stays as it is
fdb2d618144159395f7bf8ce3327b3c112a17dd3Till Mossakowski where updateVarDecls (Var_decl vl s pl) =
7c99e334446bb97120e30e967baeeddfdd1278deKlaus Luettich Var_decl vl (lkupTop subSortMap s) pl
dcbd32289a7bdf1e6edd06c6ab0698c6a9dbf37aChristian Maeder updatePRED_SYMB (Pred_name _) =
dcbd32289a7bdf1e6edd06c6ab0698c6a9dbf37aChristian Maeder error "CASL2TopSort.mapSen: got untyped predication"
dcbd32289a7bdf1e6edd06c6ab0698c6a9dbf37aChristian Maeder updatePRED_SYMB (Qual_pred_name pn (Pred_type sl pl') pl) =
12251a9d23f842673978d0ad6692527ef320c55dChristian Maeder Qual_pred_name pn
1aee4aaddde105264c1faf394d88e302c05094ffChristian Maeder (Pred_type (map (lkupTop subSortMap) sl) pl') pl
dcbd32289a7bdf1e6edd06c6ab0698c6a9dbf37aChristian Maeder -- relativize quantifiers using predicates coding sorts
1aee4aaddde105264c1faf394d88e302c05094ffChristian Maeder -- universal? the use implication
1aee4aaddde105264c1faf394d88e302c05094ffChristian Maeder relativize Universal vdl f1 =
1aee4aaddde105264c1faf394d88e302c05094ffChristian Maeder if null vdl then f1
1aee4aaddde105264c1faf394d88e302c05094ffChristian Maeder else mkImpl (mkVarPreds vdl) f1
c8acf4d00418dc649168d446e33f1ee7b1d052f1Christian Maeder -- existential or unique-existential? then use conjuction
6d549a835ffd3a11c3ed74e0f8fda30fda6a9528Christian Maeder relativize _ vdl f1 =
27785f379d6810811b4e6d23feab18845fde9a98Christian Maeder if null vdl then f1
27785f379d6810811b4e6d23feab18845fde9a98Christian Maeder else conjunct [mkVarPreds vdl, f1]
b886e9e5db2098d0112cc4f70aeba232962939ddChristian Maeder mkVarPreds = conjunct . map mkVarPred
c4451dc7da4a15726ba96179aecf046a5df5cae1Christian Maeder mkVarPred (Var_decl vs s _) = conjunct $ map (mkVarPred1 s) vs
c4451dc7da4a15726ba96179aecf046a5df5cae1Christian Maeder mkVarPred1 s v =
c4451dc7da4a15726ba96179aecf046a5df5cae1Christian Maeder let sTop = lkupTop subSortMap s
27785f379d6810811b4e6d23feab18845fde9a98Christian Maeder p = lkupPredName subSortMap s
2d130d212db7208777ca896a7ecad619a8944971Christian Maeder -- no subsort? then no relativization
e7757995211bd395dc79d26fe017d99375f7d2a6Christian Maeder Nothing -> True_atom nullRange
ac0bbbcb2774629bb87986e69cf53d3402c5f575Christian Maeder Just p1 -> genPredAppl p1 [sTop] [mkVarTerm v s]
fa21fba9ceb1ddf7b3efd54731a12ed8750191d8Christian MaedermapTerm :: SubSortMap -> TERM f -> TERM f
fa21fba9ceb1ddf7b3efd54731a12ed8750191d8Christian MaedermapTerm ssMap t = case t of
e7757995211bd395dc79d26fe017d99375f7d2a6Christian Maeder Qual_var v s pl -> Qual_var v (lTop s) pl
0c355dd0b739631ee472f9a656e266be27fa4e64Christian Maeder Application osy tl pl ->
fa21fba9ceb1ddf7b3efd54731a12ed8750191d8Christian Maeder Application (updateOP_SYMB osy) (map (mapTerm ssMap) tl) pl
e7757995211bd395dc79d26fe017d99375f7d2a6Christian Maeder Sorted_term t1 s pl ->
c7ec85d1103173e089aa5048fd7afb2f9b505124Klaus Luettich Sorted_term (mapTerm ssMap t1) (lTop s) pl
c7ec85d1103173e089aa5048fd7afb2f9b505124Klaus Luettich -- casts are discarded due to missing subsorting
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Cast t1 _ _ -> mapTerm ssMap t1
c7ec85d1103173e089aa5048fd7afb2f9b505124Klaus Luettich Conditional t1 f t2 pl ->
c7ec85d1103173e089aa5048fd7afb2f9b505124Klaus Luettich Conditional (mapTerm ssMap t1) (mapSen1 ssMap f) (mapTerm ssMap t2) pl
a883cd4d01fe39d23219cf5333425f195be24d8bChristian Maeder where lTop = lkupTop ssMap
b905126bab9454b89041f92b3c50bb9efc85e427Klaus Luettich updateOP_SYMB (Op_name _) =
c4ef79587a902327f36277c45a8d91d1e67bd6d5Klaus Luettich error "CASL2TopSort.mapTerm: got untyped application"
c4ef79587a902327f36277c45a8d91d1e67bd6d5Klaus Luettich updateOP_SYMB (Qual_op_name on ot pl) =
c4ef79587a902327f36277c45a8d91d1e67bd6d5Klaus Luettich Qual_op_name on (updateOP_TYPE ot) pl
5818d884784339c1b8aa6c6d972bad4eafd36ccbKlaus Luettich updateOP_TYPE (Op_type fk sl s pl) =
5818d884784339c1b8aa6c6d972bad4eafd36ccbKlaus Luettich Op_type fk (map lTop sl) (lTop s) pl
c4ef79587a902327f36277c45a8d91d1e67bd6d5Klaus LuettichgenEitherAxiom :: SubSortMap -> [Constraint] -> Result (FORMULA f)
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaedergenEitherAxiom ssMap =
b905126bab9454b89041f92b3c50bb9efc85e427Klaus Luettich genConjunction . (\ (_, osl, _) -> osl) . recover_Sort_gen_ax
b905126bab9454b89041f92b3c50bb9efc85e427Klaus Luettich where genConjunction osl =
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder let (injOps, constrs) = partition isInjOp osl
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder groupedInjOps = groupBy sameTarget $ sortBy compTarget injOps
33d042fe6a9eb27a4c48f840b80838f3e7d98e34Christian Maeder in if null constrs
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder then case groupedInjOps of
f38b3687c5558128515e34fb85d8b466d22dc300Christian Maeder [] -> fatal_error "No injective operation found" nullRange
f38b3687c5558128515e34fb85d8b466d22dc300Christian Maeder [xs@(x : _)] -> return $ genQuant x $ genImpl xs
f38b3687c5558128515e34fb85d8b466d22dc300Christian Maeder ((x : _) : _) -> return $ genQuant x
f38b3687c5558128515e34fb85d8b466d22dc300Christian Maeder $ conjunct $ map genImpl groupedInjOps
f38b3687c5558128515e34fb85d8b466d22dc300Christian Maeder _ -> error "CASL2TopSort.genEitherAxiom.groupedInjOps"
f38b3687c5558128515e34fb85d8b466d22dc300Christian Maeder else Result [Diag Error
f38b3687c5558128515e34fb85d8b466d22dc300Christian Maeder "CASL2TopSort: Cannot handle \
f38b3687c5558128515e34fb85d8b466d22dc300Christian Maeder \datatype constructors; only subsort \
da8353f130412f98f3c942c2d02ff2bb26babd20Christian Maeder \embeddings are allowed with free and \
f38b3687c5558128515e34fb85d8b466d22dc300Christian Maeder \generated types!" nullRange] Nothing
dbe752ee940baae7f9f231f29c62284bb0f90a25Christian Maeder isInjOp ops =
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder Op_name _ -> error "CASL2TopSort.genEitherAxiom.isInjObj"
1f8a7f8343f7df719768d2b1d7e3077ee291a1caChristian Maeder Qual_op_name on _ _ -> isInjName on
1f8a7f8343f7df719768d2b1d7e3077ee291a1caChristian Maeder resultSort (Qual_op_name _ (Op_type _ _ t _) _) = t
c1bf9cc3bc3729b0bf925be3be123cbb59bea2a6Christian Maeder resultSort _ = error "CASL2TopSort.genEitherAxiom.resultSort"
c1bf9cc3bc3729b0bf925be3be123cbb59bea2a6Christian Maeder argSort (Qual_op_name _ (Op_type _ [x] _ _) _) = x
1f8a7f8343f7df719768d2b1d7e3077ee291a1caChristian Maeder argSort _ = error "CASL2TopSort.genEitherAxiom.argSort"
96646aed2ae087b942ae23f15bbe729a8f7c43d3Christian Maeder compTarget x1 x2 = compare (resultSort x1) (resultSort x2)
96646aed2ae087b942ae23f15bbe729a8f7c43d3Christian Maeder sameTarget x1 x2 = compTarget x1 x2 == EQ
1f8a7f8343f7df719768d2b1d7e3077ee291a1caChristian Maeder lTop = lkupTop ssMap
3a7788e09dd23b364a46c9488cbd1522369113dbChristian Maeder mkXVarDecl = mkVarDeclStr "x" . lTop . resultSort
e7757995211bd395dc79d26fe017d99375f7d2a6Christian Maeder genQuant qon f = mkForall [mkXVarDecl qon] f nullRange
f38b3687c5558128515e34fb85d8b466d22dc300Christian Maeder genImpl xs = case xs of
1f8a7f8343f7df719768d2b1d7e3077ee291a1caChristian Maeder rSrt = resultSort x
ac0bbbcb2774629bb87986e69cf53d3402c5f575Christian Maeder ltSrt = lTop rSrt
aebb0b18fe5e6ba7dd7e4c66a16a905611ef7ba9Christian Maeder disjs = genDisj xs
e05fd774e0181e93963d4302303b20698603a505Christian Maeder in if ltSrt == lTop (argSort x) then
ac0bbbcb2774629bb87986e69cf53d3402c5f575Christian Maeder if rSrt == ltSrt then disjs else mkImpl (genProp x) disjs
aebb0b18fe5e6ba7dd7e4c66a16a905611ef7ba9Christian Maeder else error "CASL2TopSort.genEitherAxiom.genImpl"
ac0bbbcb2774629bb87986e69cf53d3402c5f575Christian Maeder _ -> error "CASL2TopSort.genEitherAxiom.genImpl No OP_SYMB found"
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder genProp qon =
e05fd774e0181e93963d4302303b20698603a505Christian Maeder genPredication (lPredName $ resultSort qon) [mkXVarDecl qon]
ac0bbbcb2774629bb87986e69cf53d3402c5f575Christian Maeder lPredName s = fromMaybe (error $
f2d9352f2999f82c36b4b65535d14a6a40ae5a82Christian Maeder "CASL2TopSort.genEitherAxiom: No PRED_NAME for \""
340706b6c0c6e3dbacdd7003e20e9cab7f9aa765Christian Maeder ++ shows s "\" found!") $ lkupPredName ssMap s
43bb71dfe7ec405f563864d57c1cacdaa8ce9a80Christian Maeder genDisj qons = Disjunction (map genPred qons) nullRange
f2d9352f2999f82c36b4b65535d14a6a40ae5a82Christian Maeder genPred qon =
fdb2d618144159395f7bf8ce3327b3c112a17dd3Till Mossakowski genPredication (lPredName $ argSort qon) [mkXVarDecl qon]