Sublogic.hs revision 1a38107941725211e7c3f051f7a8f5e12199f03a
43b4c41fbb07705c9df321221ab9cb9832460407Christian Maeder{-# LANGUAGE DeriveDataTypeable #-}
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaederModule : $Header$
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian MaederDescription : sublogic analysis for CASL
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaederCopyright : (c) Pascal Schmidt, C. Maeder, and Uni Bremen 2002-2006
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian MaederLicense : GPLv2 or higher, see LICENSE.txt
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian MaederMaintainer : Christian.Maeder@dfki.de
43b4c41fbb07705c9df321221ab9cb9832460407Christian MaederStability : experimental
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian MaederPortability : portable
f2f9df2e17e70674f0bf426ed1763c973ee4cde0Christian MaederSublogic analysis for CASL
c9a7e6af169a2adfb92f42331cd578065ed83a2bChristian MaederThis module provides the sublogic functions (as required by Logic.hs)
e7757995211bd395dc79d26fe017d99375f7d2a6Christian Maeder for CASL. The functions allow to compute the minimal sublogics needed
e7757995211bd395dc79d26fe017d99375f7d2a6Christian Maeder by a given element, to check whether an item is part of a given
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder sublogic, and to project an element into a given sublogic.
b1f59a4ea7c96f4c03a4d7cfcb9c5e66871cfbbbChristian Maeder CASL_Sublogics
ad270004874ce1d0697fb30d7309f180553bb315Christian Maeder , CASL_SL (..)
4d56f2fa72e4aec20eb827c11ed49c8cbb7014bdChristian Maeder , CASL_Formulas (..)
4cb215739e9ab13447fa21162482ebe485b47455Christian Maeder , SubsortingFeatures (..)
8ef75f1cc0437656bf622cec5ac9e8ea221da8f2Christian Maeder , SortGenerationFeatures (..)
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder , Lattice (..)
74eed04be26f549d2f7ca35c370e1c03879b28b1Christian Maeder -- * predicates on CASL_SL
ef9e8535c168d3f774d9e74368a2317a9eda5826Christian Maeder -- * functions for SemiLatticeWithTop instance
e593b89bfd4952698dc37feced21cefe869d87a2Christian Maeder , sublogics_max
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder -- * functions for the creation of minimal sublogics
f4a2a20e49f41b2afa657e5e64d9e349c7faa091Christian Maeder , emptyMapConsFeature
1aee4aaddde105264c1faf394d88e302c05094ffChristian Maeder , updExtFeature
8b767d09a78927b111f5596fdff9ca7d2c1a439fChristian Maeder -- * functions for Logic instance sublogic to string conversion
8b767d09a78927b111f5596fdff9ca7d2c1a439fChristian Maeder , sublogics_name
8b767d09a78927b111f5596fdff9ca7d2c1a439fChristian Maeder -- ** list of all sublogics
8b767d09a78927b111f5596fdff9ca7d2c1a439fChristian Maeder , sublogics_all
d54cd08a4cfa26256c38d8ed12c343adbfe1a0e3Christian Maeder -- * computes the sublogic of a given element
308834907a120fd8771e18292ed2ca9cd767c12dChristian Maeder , sl_sig_items
bab2d88d650448628730ed3b65c9f99c52500e8cChristian Maeder , sl_basic_spec
a7c27282e71cf4505026645f96d4f5cb8a284e32Christian Maeder , sl_pred_item
363939beade943a02b31004cea09dec34fa8a6d9Christian Maeder , sl_sentence
f04e8f3ff56405901be968fd4c6e9769239f1a9bKlaus Luettich , sl_symb_items
6aea82c63ba1d2efc0329bc784a14e521469ec20Christian Maeder , sl_symb_map_items
feca1d35123d8c31aee238c9ce79947b0bf65494Christian Maeder , sl_morphism
f1541d4a151dbd08002dbd14e7eb1d5dde253689Christian Maeder -- * projects an element into a given sublogic
db675e8302ddb0d6528088ce68f5e98a00e890e3Christian Maeder , pr_basic_spec
db675e8302ddb0d6528088ce68f5e98a00e890e3Christian Maeder , pr_symb_items
f1541d4a151dbd08002dbd14e7eb1d5dde253689Christian Maeder , pr_symb_map_items
6dc9bc98d0854fe2e3dd3bfc4275096a0c28ee1cChristian Maeder , pr_morphism
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maederimport qualified Data.Map as Map
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maederimport qualified Data.Set as Set
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian Maederimport qualified Common.Lib.MapSet as MapSet
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian Maederimport qualified Common.Lib.Rel as Rel
a42fbfe7becf0eae2d624123eb0db73a794593f0Christian Maeder{- ----------------------------------------------------------------------------
a42fbfe7becf0eae2d624123eb0db73a794593f0Christian Maederdatatypes for CASL sublogics
b363eb04791e7f735633b9b4088502c2bc50ebfcChristian Maeder---------------------------------------------------------------------------- -}
1cd4f6541984962658add5cfaa9f28a93879881bChristian Maederdata CASL_Formulas = Atomic -- ^ atomic logic
1cd4f6541984962658add5cfaa9f28a93879881bChristian Maeder | Horn -- ^ positive conditional logic
2d130d212db7208777ca896a7ecad619a8944971Christian Maeder | GHorn -- ^ generalized positive conditional logic
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian Maeder | FOL -- ^ first-order logic
6ff7a91875597d6e4dfaa68c79187d01473e8341Christian Maeder | SOL -- ^ second-order logic
6ff7a91875597d6e4dfaa68c79187d01473e8341Christian Maeder deriving (Show, Eq, Ord, Typeable, Data)
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian Maederdata SubsortingFeatures = NoSub
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian Maeder deriving (Show, Eq, Ord, Typeable, Data)
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian Maederdata SortGenerationFeatures =
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian Maeder | SortGen { emptyMapping :: Bool
a3c6d8e0670bf2aa71bc8e2a3b1f45d56dd65e4cChristian Maeder -- ^ Mapping of indexed sorts is empty
dc679edd4ca027663212afdf00926ae2ce19b555Christian Maeder , onlyInjConstrs :: Bool
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder -- ^ only constructors that are subsort injections
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maeder } deriving (Show, Eq, Ord, Typeable, Data)
ca074a78b8dcccbb8c419586787882f98d0c6163Christian MaederjoinSortGenFeature :: (Bool -> Bool -> Bool)
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maeder -> SortGenerationFeatures -> SortGenerationFeatures
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maeder -> SortGenerationFeatures
4017ebc0f692820736d796af3110c3b3018c108aChristian MaederjoinSortGenFeature f x y =
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maeder NoSortGen -> y
0be0db405c49906bd7057255069bf6df53395ac9Klaus Luettich SortGen em_x ojc_x -> case y of
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maeder NoSortGen -> x
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder SortGen em_y ojc_y -> SortGen (f em_x em_y) (f ojc_x ojc_y)
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maederdata CASL_SL a = CASL_SL
f2f9df2e17e70674f0bf426ed1763c973ee4cde0Christian Maeder { sub_features :: SubsortingFeatures, -- ^ subsorting
d946c1bfdd7d58aa7c023efe864d5999eb44a61bChristian Maeder has_part :: Bool, -- ^ partiality
d946c1bfdd7d58aa7c023efe864d5999eb44a61bChristian Maeder cons_features :: SortGenerationFeatures, -- ^ sort generation constraints
d946c1bfdd7d58aa7c023efe864d5999eb44a61bChristian Maeder has_eq :: Bool, -- ^ equality
d946c1bfdd7d58aa7c023efe864d5999eb44a61bChristian Maeder has_pred :: Bool, -- ^ predicates
d946c1bfdd7d58aa7c023efe864d5999eb44a61bChristian Maeder which_logic :: CASL_Formulas, -- ^ first order sublogics
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder has_empty_sorts :: Bool, -- ^ may sorts be empty
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder ext_features :: a -- ^ features of extension
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder } deriving (Show, Eq, Ord, Typeable, Data)
ca074a78b8dcccbb8c419586787882f98d0c6163Christian MaederupdExtFeature :: (a -> a) -> CASL_SL a -> CASL_SL a
ca074a78b8dcccbb8c419586787882f98d0c6163Christian MaederupdExtFeature f s = s { ext_features = f $ ext_features s }
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maedertype CASL_Sublogics = CASL_SL ()
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maeder{- -----------------------
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maederold selector functions
3e8b136f23ed57d40ee617f49bcac37830b58cabChristian Maeder----------------------- -}
6dc9bc98d0854fe2e3dd3bfc4275096a0c28ee1cChristian Maederhas_sub :: CASL_SL a -> Bool
d946c1bfdd7d58aa7c023efe864d5999eb44a61bChristian Maederhas_sub sl = case sub_features sl of
e6d5dbbc3308f05197868806e0b860f4f53875f1Christian Maeder NoSub -> False
eb74267cf39e4e95f9eeb5c765f4c8dac33971b4Christian Maederhas_cons :: CASL_SL a -> Bool
eb74267cf39e4e95f9eeb5c765f4c8dac33971b4Christian Maederhas_cons sl = case cons_features sl of
e4f4d096e5e6d60dd91c746d0e833d0ac7a29c50Christian Maeder NoSortGen -> False
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder{- ---------------------------------------------------------------------------
f1541d4a151dbd08002dbd14e7eb1d5dde253689Christian MaederSpecial sublogics elements
8d178ae08a52d61379e6b8074f61646499bc88bbChristian Maeder--------------------------------------------------------------------------- -}
6cd33d6101fb1b93baa6d86fac158af18a115108Christian Maeder-- top element
6cd33d6101fb1b93baa6d86fac158af18a115108Christian MaedermkTop :: a -> CASL_SL a
6cd33d6101fb1b93baa6d86fac158af18a115108Christian MaedermkTop = CASL_SL Sub True (SortGen False False) True True SOL True
6cd33d6101fb1b93baa6d86fac158af18a115108Christian Maedertop :: Lattice a => CASL_SL a
b2ac5a92cf36382e8deea5661c1964566caf72b3Christian Maedertop = mkTop ctop
b2ac5a92cf36382e8deea5661c1964566caf72b3Christian MaedercaslTop :: Lattice a => CASL_SL a
6cd33d6101fb1b93baa6d86fac158af18a115108Christian Maeder { has_empty_sorts = False
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder , which_logic = FOL
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaedercFol :: Lattice a => CASL_SL a
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaedercFol = caslTop
0e5b095a19790411e5352fa7cf57cb0388e70472Christian Maeder { sub_features = NoSub -- no subsorting
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder , has_part = False -- no partiality
f1a913f880e409e7327b5deae95738b5448379a1Christian MaedermkBot :: a -> CASL_SL a
f1a913f880e409e7327b5deae95738b5448379a1Christian MaedermkBot = CASL_SL NoSub False NoSortGen False False Atomic False
f1a913f880e409e7327b5deae95738b5448379a1Christian Maeder-- bottom element
c9a7e6af169a2adfb92f42331cd578065ed83a2bChristian Maederbottom :: Lattice a => CASL_SL a
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maederbottom = mkBot bot
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maederneed_empty_sorts :: Lattice a => CASL_SL a
93f5b72fdb9ee734caa750b43dd79bbb590dcd73Christian Maederneed_empty_sorts = bottom { has_empty_sorts = True }
93f5b72fdb9ee734caa750b43dd79bbb590dcd73Christian Maeder{- the following are used to add a needed feature to a given
93f5b72fdb9ee734caa750b43dd79bbb590dcd73Christian Maedersublogic via sublogics_max, i.e. (sublogics_max given needs_part)
328a85c807f2a95c3f147d10b05927eaf862ebebChristian Maederwill force partiality in addition to what features given already
308834907a120fd8771e18292ed2ca9cd767c12dChristian Maederhas included -}
254df6f22d01eacf7c57b85729e0445747b630d9Christian Maeder-- minimal sublogics with subsorting
4ba08bfca0cc8d9da65397b8dfd2654fdb4c0e62Christian Maederneed_sub :: Lattice a => CASL_SL a
bff4b3f816be4c1e1d8ded76f1d5af786839e1a9Christian Maederneed_sub = need_horn { sub_features = Sub }
8b0f493ae42bad8b94918cc0957f1af57096cda4Felix Reckersneed_sul :: Lattice a => CASL_SL a
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maederneed_sul = need_horn { sub_features = LocFilSub }
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder-- minimal sublogic with partiality
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maederneed_part :: Lattice a => CASL_SL a
140287998aa8592c9c403bd9e308e447ba92ae11Christian Maederneed_part = bottom { has_part = True }
c208973c890b8f993297720fd0247bc7481d4304Christian MaederemptyMapConsFeature :: SortGenerationFeatures
aded505f9b42cc38975559c2a5d175ae95de436bChristian MaederemptyMapConsFeature = SortGen
3e8b136f23ed57d40ee617f49bcac37830b58cabChristian Maeder { emptyMapping = True
8b0f493ae42bad8b94918cc0957f1af57096cda4Felix Reckers , onlyInjConstrs = False }
9e748851c150e1022fb952bab3315e869aaf0214Christian Maeder-- minimal sublogics with sort generation constraints
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maederneed_cons :: Lattice a => CASL_SL a
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maederneed_cons = bottom
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder { cons_features = SortGen { emptyMapping = False
383aa66e5142365fe9b1f88b18c1da5b27cc8c04Christian Maeder , onlyInjConstrs = False} }
383aa66e5142365fe9b1f88b18c1da5b27cc8c04Christian Maederneed_e_cons :: Lattice a => CASL_SL a
383aa66e5142365fe9b1f88b18c1da5b27cc8c04Christian Maederneed_e_cons = bottom
aded505f9b42cc38975559c2a5d175ae95de436bChristian Maeder { cons_features = emptyMapConsFeature }
aded505f9b42cc38975559c2a5d175ae95de436bChristian Maederneed_s_cons :: Lattice a => CASL_SL a
aded505f9b42cc38975559c2a5d175ae95de436bChristian Maederneed_s_cons = bottom
aded505f9b42cc38975559c2a5d175ae95de436bChristian Maeder { cons_features = SortGen { emptyMapping = False
aded505f9b42cc38975559c2a5d175ae95de436bChristian Maeder , onlyInjConstrs = True} }
383aa66e5142365fe9b1f88b18c1da5b27cc8c04Christian Maederneed_se_cons :: Lattice a => CASL_SL a
a14767aeac3e78ed100f5b75e210ba563ee10dbaChristian Maederneed_se_cons = bottom
a14767aeac3e78ed100f5b75e210ba563ee10dbaChristian Maeder { cons_features = SortGen { emptyMapping = True
a14767aeac3e78ed100f5b75e210ba563ee10dbaChristian Maeder , onlyInjConstrs = True} }
aded505f9b42cc38975559c2a5d175ae95de436bChristian Maeder-- minimal sublogic with equality
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maederneed_eq :: Lattice a => CASL_SL a
54ea981a0503c396c2923a1c06421c6235baf27fChristian Maederneed_eq = bottom { has_eq = True }
54ea981a0503c396c2923a1c06421c6235baf27fChristian Maeder-- minimal sublogic with predicates
697e63e30aa3c309a1ef1f9357745111f8dfc5a9Christian Maederneed_pred :: Lattice a => CASL_SL a
aded505f9b42cc38975559c2a5d175ae95de436bChristian Maederneed_pred = bottom { has_pred = True }
f9e0b18852b238ddb649d341194e05d7200d1bbeChristian Maederneed_horn :: Lattice a => CASL_SL a
aded505f9b42cc38975559c2a5d175ae95de436bChristian Maederneed_horn = bottom { which_logic = Horn }
819e29dba060687cf391e444e0f6ff88c1908cc3Christian Maederneed_fol :: Lattice a => CASL_SL a
819e29dba060687cf391e444e0f6ff88c1908cc3Christian Maederneed_fol = bottom { which_logic = FOL }
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder{- ---------------------------------------------------------------------------
254df6f22d01eacf7c57b85729e0445747b630d9Christian MaederFunctions to generate a list of all sublogics for CASL
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder--------------------------------------------------------------------------- -}
254df6f22d01eacf7c57b85729e0445747b630d9Christian Maeder{- all elements
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maedercreate a list of all CASL sublogics by generating all possible
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maederfeature combinations and then filtering illegal ones out -}
254df6f22d01eacf7c57b85729e0445747b630d9Christian Maedersublogics_all :: Lattice a => [a] -> [CASL_SL a]
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maedersublogics_all l = bottom : map mkBot l ++ concat (sDims [])
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder ++ let subPAtom = (sublogics_max need_part need_pred) { sub_features = Sub } in
aded505f9b42cc38975559c2a5d175ae95de436bChristian Maeder [ sublogics_max need_fol need_eq
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder , comp_list [subPAtom, need_horn, need_eq]
ac34194a668399bb8ef238da77c3a09e93fb253bChristian Maeder , sublogics_max subPAtom need_cons
4fc9de0da898448f1d3597ebbd8c04a066464c21Christian Maeder , cFol, caslTop, top]
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian MaedersDims :: Lattice a => [[a]] -> [[CASL_SL a]]
1842453990fed8a1bd7a5ac792d7982c1d2bfcd5Christian Maeder bools = [True, False]
1842453990fed8a1bd7a5ac792d7982c1d2bfcd5Christian Maeder map (map mkBot) l ++
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder [ [ b { sub_features = s_f } | s_f <- [LocFilSub, Sub]]
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder , [b { has_part = t } ]
986d3f255182539098a97ac86da9eeee5b7a72e3Christian Maeder , [b { cons_features = c_f } | c_f <- [ SortGen m s | m <- bools, s <- bools]]
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder , [b { has_eq = t } ]
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder , [b { has_pred = t } ]
01e278bdd7dce13b9303ed3d79683d83c89d09f9Liam O'Reilly , [b { has_empty_sorts = t } ]
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder , [b { which_logic = fo } | fo <- reverse [SOL, FOL, GHorn, Horn]]]
8c812cd83569e973f10cf69a342424ceabc07af9Christian Maeder{- ----------------------------------------------------------------------------
8c812cd83569e973f10cf69a342424ceabc07af9Christian MaederConversion functions (to String)
8c812cd83569e973f10cf69a342424ceabc07af9Christian Maeder---------------------------------------------------------------------------- -}
31d6d9286988dc31639d105841296759aeb743e0Jonathan von Schroederformulas_name :: Bool -> CASL_Formulas -> String
1535e1d8c82db5f7e2402261983c4c2ef39f4f39Mihai Codescuformulas_name b f = let Just s = lookup (b, f) nameList in s
7a3fe82695aa32657693e05712f84d7f81672f2eJonathan von SchroedernameList :: [((Bool, CASL_Formulas), String)]
7a3fe82695aa32657693e05712f84d7f81672f2eJonathan von Schroeder [ ((True, SOL), "SOL")
05a206508bc898f87fe6ab6e069814df3c29d303Dominik Luecke , ((False, SOL), "SOAlg")
05a206508bc898f87fe6ab6e069814df3c29d303Dominik Luecke , ((True, FOL), "FOL")
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder , ((False, FOL), "FOAlg")
d54cd08a4cfa26256c38d8ed12c343adbfe1a0e3Christian Maeder , ((True, GHorn), "GHorn")
d54cd08a4cfa26256c38d8ed12c343adbfe1a0e3Christian Maeder , ((False, GHorn), "GCond")
d54cd08a4cfa26256c38d8ed12c343adbfe1a0e3Christian Maeder , ((True, Horn), "Horn")
3b06e23643a9f65390cb8c1caabe83fa7e87a708Till Mossakowski , ((False, Horn), "Cond")
b1f59a4ea7c96f4c03a4d7cfcb9c5e66871cfbbbChristian Maeder , ((True, Atomic), "Atom")
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder , ((False, Atomic), "Eq")]
0b349288edfa50fdf38fda1a14e1562d03f92574Christian Maedersublogics_name :: (a -> String) -> CASL_SL a -> String
5afff1a0f62394414c33b06141175b3ab0b117a5Christian Maedersublogics_name f x = f (ext_features x)
5afff1a0f62394414c33b06141175b3ab0b117a5Christian Maeder ++ (case sub_features x of
1b3a2f98d1cd01fc9e0591f69507e20526727559Dominik Luecke LocFilSub -> "Sul"
f04e8f3ff56405901be968fd4c6e9769239f1a9bKlaus Luettich Sub -> "Sub")
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder ++ (if has_part x then "P" else "")
f8e1a1eca871a26a535a4ee7d51902ba94b1db1eChristian Maeder ++ (if has_cons x
ea3bff3e547a1ac714d4db39c5efef95e02b2e7dChristian Maeder then (if onlyInjConstrs (cons_features x)
dd6f22b9dcff2695181b86372e4df03d5b96e92dKristina Sojakova then "s" else "") ++
005e0f0c6b0cc898003b03801158c208f3071fc5Kristina Sojakova (if emptyMapping (cons_features x)
abf2487c3aece95c371ea89ac64319370dcb6483Klaus Luettich then "e" else "") ++ "C"
23b4e542dca35852f58d1fb3f7d9078c1de5ab06Christian Maeder ++ formulas_name (has_pred x) (which_logic x)
23b4e542dca35852f58d1fb3f7d9078c1de5ab06Christian Maeder ++ (if has_eq x then "=" else "")
76b9b2974795a6fb31f242fd032de3ff66df6204Christian Maeder ++ if has_empty_sorts x then "E" else ""
8a78868bae2ec6838c87366c35c57e109154c51eChristian MaederparseBool :: String -> String -> (Bool, String)
878a5ecd6acf973907e25e5be6e4a792ea19a05eEwaryst SchulzparseBool p s = case stripPrefix p s of
878a5ecd6acf973907e25e5be6e4a792ea19a05eEwaryst Schulz Just r -> (True, r)
c2e192ace9ef7cfb0e59563f1b24477b2b65cff3Dominik Dietrich Nothing -> (False, s)
9a4b469ca0a7f44a598e551a973c75195207db58Eugen KuksaparseSL :: (String -> Maybe (a, String)) -> String -> Maybe (CASL_SL a)
48aa0645e25883048369afc02aac3f49b14a50daChristian MaederparseSL f s0 = do
01645eac73dbc789392674930adc5745c935f3a0Christian Maeder (a, s1) <- f s0
01645eac73dbc789392674930adc5745c935f3a0Christian Maeder (sub, s2) <- case stripPrefix "Su" s1 of
bff4b3f816be4c1e1d8ded76f1d5af786839e1a9Christian Maeder Just r -> case r of
bff4b3f816be4c1e1d8ded76f1d5af786839e1a9Christian Maeder c : t -> case c of
7dc37844730a8b23973139e9720574382de109e7Alexis Tsogias 'l' -> Just (LocFilSub, t)
b5da047a9a875dec3f968b6c0df96af326f90fa9Alexis Tsogias 'b' -> Just (Sub, t)
0a03acf9fa28e6ff00f4d7c9c6acbae64cf09c56Ewaryst Schulz "" -> Nothing
a604cbad8e2202147b5c6bb9f2e06ae61162d654Felix Gabriel Mance Nothing -> Just (NoSub, s1)
308834907a120fd8771e18292ed2ca9cd767c12dChristian Maeder let (pa, s3) = parseBool "P" s2
308834907a120fd8771e18292ed2ca9cd767c12dChristian Maeder (c, s4) = parseCons s3
bab2d88d650448628730ed3b65c9f99c52500e8cChristian Maeder ((pr, l), s5) <- parseForm s4
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder let (eq, s6) = parseBool "=" s5
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder (es, s7) = parseBool "E" s6
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder unless (null s7) Nothing
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder return (mkBot a)
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder { sub_features = sub
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder , has_part = pa
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder , cons_features = c
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder , has_pred = pr
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder , which_logic = l
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder , has_eq = eq
7a3fe82695aa32657693e05712f84d7f81672f2eJonathan von Schroeder , has_empty_sorts = es }
7a3fe82695aa32657693e05712f84d7f81672f2eJonathan von SchroederparseForm :: String -> Maybe ((Bool, CASL_Formulas), String)
1535e1d8c82db5f7e2402261983c4c2ef39f4f39Mihai CodescuparseForm s = foldr (\ (q, p) m -> case m of
1535e1d8c82db5f7e2402261983c4c2ef39f4f39Mihai Codescu Nothing -> case stripPrefix p s of
1535e1d8c82db5f7e2402261983c4c2ef39f4f39Mihai Codescu Just r -> Just (q, r)
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Nothing -> m) Nothing nameList
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaederparseCons :: String -> (SortGenerationFeatures, String)
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaederparseCons s = case stripPrefix "seC" s of
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Just r -> (SortGen True True, r)
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Nothing -> case stripPrefix "sC" s of
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Just r -> (SortGen False True, r)
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Nothing -> case stripPrefix "eC" s of
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Just r -> (SortGen True False, r)
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Nothing -> case stripPrefix "C" s of
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Just r | not $ isPrefixOf "ond" r -> (SortGen False False, r)
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder _ -> (NoSortGen, s)
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder{- ----------------------------------------------------------------------------
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maederjoin or max functions
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder---------------------------------------------------------------------------- -}
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maedersublogics_join :: (Bool -> Bool -> Bool)
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder -> (SubsortingFeatures -> SubsortingFeatures
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder -> SubsortingFeatures)
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder -> (SortGenerationFeatures -> SortGenerationFeatures
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder -> SortGenerationFeatures)
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder -> (CASL_Formulas -> CASL_Formulas -> CASL_Formulas)
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder -> (a -> a -> a)
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder -> CASL_SL a -> CASL_SL a -> CASL_SL a
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maedersublogics_join jB jS jC jF jE a b = CASL_SL
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder { sub_features = jS (sub_features a) (sub_features b)
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder , ext_features = jE (ext_features a) (ext_features b)
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder , has_part = jB (has_part a) $ has_part b
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder , cons_features = jC (cons_features a) (cons_features b)
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder , has_eq = jB (has_eq a) $ has_eq b
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder , has_pred = jB (has_pred a) $ has_pred b
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder , has_empty_sorts = jB (has_empty_sorts a) $ has_empty_sorts b
3e8b136f23ed57d40ee617f49bcac37830b58cabChristian Maeder , which_logic = jF (which_logic a) (which_logic b)
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maedersublogics_max :: Lattice a => CASL_SL a -> CASL_SL a
9f85afecbd79b3df5a0bb17bd28cd0b288dc3213Kristina Sojakovasublogics_max = sublogics_join max max (joinSortGenFeature min) max cjoin
9f85afecbd79b3df5a0bb17bd28cd0b288dc3213Kristina Sojakova{- ----------------------------------------------------------------------------
79834070d6d3c63a098e570b12fa3405c607dc70Kristina SojakovaHelper functions
79834070d6d3c63a098e570b12fa3405c607dc70Kristina Sojakova---------------------------------------------------------------------------- -}
23b4e542dca35852f58d1fb3f7d9078c1de5ab06Christian Maeder-- compute sublogics from a list of sublogics
23b4e542dca35852f58d1fb3f7d9078c1de5ab06Christian Maedercomp_list :: Lattice a => [CASL_SL a] -> CASL_SL a
23b4e542dca35852f58d1fb3f7d9078c1de5ab06Christian Maedercomp_list = foldl sublogics_max bottom
8a78868bae2ec6838c87366c35c57e109154c51eChristian Maeder{- map a function returning Maybe over a list of arguments
8a78868bae2ec6838c87366c35c57e109154c51eChristian Maeder. a list of Pos is maintained by removing an element if the
624e6701e0deb7ac6c03c0cba0190fbc5033cf93Ewaryst Schulzfunction f returns Nothing on the corresponding element of
624e6701e0deb7ac6c03c0cba0190fbc5033cf93Ewaryst Schulzthe argument list
c2e192ace9ef7cfb0e59563f1b24477b2b65cff3Dominik Dietrich. leftover elements in the Pos list after the argument
7165a916d2fa1bf87c4741ec63b253413eebbf69Karl Luclist is exhausted are appended at the end with Nothing
7165a916d2fa1bf87c4741ec63b253413eebbf69Karl Lucas a substitute for f's result -}
7165a916d2fa1bf87c4741ec63b253413eebbf69Karl LucmapMaybePos :: [Pos] -> (a -> Maybe b) -> [a] -> [(Maybe b, Pos)]
01645eac73dbc789392674930adc5745c935f3a0Christian MaedermapMaybePos [] _ _ = []
01645eac73dbc789392674930adc5745c935f3a0Christian MaedermapMaybePos (p1 : pl) f [] = (Nothing, p1) : mapMaybePos pl f []
01645eac73dbc789392674930adc5745c935f3a0Christian MaedermapMaybePos (p1 : pl) f (h : t) = let res = f h in
bff4b3f816be4c1e1d8ded76f1d5af786839e1a9Christian Maeder (if isJust res then ((res, p1) :) else id) $ mapMaybePos pl f t
bff4b3f816be4c1e1d8ded76f1d5af786839e1a9Christian Maeder{- map with partial function f on Maybe type
b5da047a9a875dec3f968b6c0df96af326f90fa9Alexis Tsogiaswill remove elements from given Pos list for elements of [a]
fc09e0a6af734edbd944dd8082bb51985c233b43Alexis Tsogiaswhere f returns Nothing
b5da047a9a875dec3f968b6c0df96af326f90fa9Alexis Tsogiasgiven number of elements from the beginning of Range are always
0a03acf9fa28e6ff00f4d7c9c6acbae64cf09c56Ewaryst SchulzmapPos :: Int -> Range -> (a -> Maybe b) -> [a] -> ([b], Range)
0a03acf9fa28e6ff00f4d7c9c6acbae64cf09c56Ewaryst SchulzmapPos c (Range p) f l = let
bab2d88d650448628730ed3b65c9f99c52500e8cChristian Maeder (res, pos) = unzip $ mapMaybePos (drop c p) f l
0a03acf9fa28e6ff00f4d7c9c6acbae64cf09c56Ewaryst Schulz (catMaybes res, Range (take c p ++ pos))
c70ef4c3b3a62764f715510c9fd67dde3acfe454Christian Maeder{- ----------------------------------------------------------------------------
61fa0ac06ede811c7aad54ec4c4202346727368eChristian MaederFunctions to analyse formulae
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder---------------------------------------------------------------------------- -}
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder{- ---------------------------------------------------------------------------
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder These functions are based on Till Mossakowski's paper "Sublanguages of
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder CASL", which is CoFI Note L-7. The functions implement an adaption of
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder the reduced grammar given there for formulae in a specific expression
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder logic by, checking whether a formula would match the productions from the
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder--------------------------------------------------------------------------- -}
9e748851c150e1022fb952bab3315e869aaf0214Christian Maedersl_form_level :: (f -> CASL_Formulas)
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder -> (Bool, Bool) -> FORMULA f -> CASL_Formulas
fdb2d618144159395f7bf8ce3327b3c112a17dd3Till Mossakowskisl_form_level ff (isCompound, leftImp) phi =
43b4c41fbb07705c9df321221ab9cb9832460407Christian Maeder Quantification q _ f _ ->
8c812cd83569e973f10cf69a342424ceabc07af9Christian Maeder let ql = sl_form_level ff (isCompound, leftImp) f
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder in if is_atomic_q q then ql else max FOL ql
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder Junction j l _ -> maximum $ case j of
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder Con -> map (sl_form_level ff (True, leftImp)) l
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder Dis -> FOL : map (sl_form_level ff (False, False)) l
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich Relation l1 c l2 _ -> maximum $ sl_form_level ff (True, True) l1
10883d13973c46cac98964b66ace7a52b2d059abChristian Maeder Equivalence -> [ sl_form_level ff (True, True) l2
f443a57f2a8e0ca3daa7431b0c89a18ba52c337aChristian Maeder , if leftImp then FOL else GHorn ]
e284004f10a315dbdb624c8b2522f65d485eaa48Martin Kühl _ -> [ sl_form_level ff (True, False) l2
857992065be4ed40a72c6296b6c0aec62ab4c5b9Christian Maeder , if leftImp then FOL else
fdb2d618144159395f7bf8ce3327b3c112a17dd3Till Mossakowski if isCompound then GHorn else Horn ]
7c99e334446bb97120e30e967baeeddfdd1278deKlaus Luettich Negation f _ -> max FOL $ sl_form_level ff (False, False) f
dcbd32289a7bdf1e6edd06c6ab0698c6a9dbf37aChristian Maeder Atom b _ -> if b then Atomic else FOL
dcbd32289a7bdf1e6edd06c6ab0698c6a9dbf37aChristian Maeder Equation _ e _ _
dcbd32289a7bdf1e6edd06c6ab0698c6a9dbf37aChristian Maeder | e == Existl -> Atomic
fc436618ae33856afa329ee53c4f47a2e19100eeChristian Maeder | leftImp -> FOL
27785f379d6810811b4e6d23feab18845fde9a98Christian Maeder | otherwise -> Horn
2d130d212db7208777ca896a7ecad619a8944971Christian Maeder QuantOp {} -> SOL -- it can't get worse
2d130d212db7208777ca896a7ecad619a8944971Christian Maeder QuantPred {} -> SOL
e7757995211bd395dc79d26fe017d99375f7d2a6Christian Maeder ExtFORMULA f -> ff f
fa21fba9ceb1ddf7b3efd54731a12ed8750191d8Christian Maederis_atomic_q :: QUANTIFIER -> Bool
fa21fba9ceb1ddf7b3efd54731a12ed8750191d8Christian Maederis_atomic_q Universal = True
e7757995211bd395dc79d26fe017d99375f7d2a6Christian Maederis_atomic_q _ = False
fa21fba9ceb1ddf7b3efd54731a12ed8750191d8Christian Maeder-- compute logic of a formula by checking all logics in turn
e7757995211bd395dc79d26fe017d99375f7d2a6Christian Maederget_logic :: Lattice a => (f -> CASL_SL a)
c7ec85d1103173e089aa5048fd7afb2f9b505124Klaus Luettich -> FORMULA f -> CASL_SL a
c7ec85d1103173e089aa5048fd7afb2f9b505124Klaus Luettichget_logic ff f = bottom
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder { which_logic = sl_form_level (which_logic . ff) (False, False) f }
c7ec85d1103173e089aa5048fd7afb2f9b505124Klaus Luettich-- for the formula inside a subsort-defn
810746aea00b81c1eec27dae84d73a43599ff056Christian Maederget_logic_sd :: Lattice a => (f -> CASL_SL a)
a883cd4d01fe39d23219cf5333425f195be24d8bChristian Maeder -> FORMULA f -> CASL_SL a
b905126bab9454b89041f92b3c50bb9efc85e427Klaus Luettichget_logic_sd ff f = bottom
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder { which_logic =
33d042fe6a9eb27a4c48f840b80838f3e7d98e34Christian Maeder max Horn $ sl_form_level (which_logic . ff) (False, False) f }
0a5571c8adeddd27548445546491725beb224dddChristian Maeder{- ----------------------------------------------------------------------------
0a5571c8adeddd27548445546491725beb224dddChristian MaederFunctions to compute minimal sublogic for a given element, these work
0a5571c8adeddd27548445546491725beb224dddChristian Maederby recursing into all subelements
0a5571c8adeddd27548445546491725beb224dddChristian Maeder---------------------------------------------------------------------------- -}
f38b3687c5558128515e34fb85d8b466d22dc300Christian Maedersl_basic_spec :: Lattice a => (b -> CASL_SL a)
e112e83352048f3db8c8f93ae104193e7338c10fChristian Maeder -> (s -> CASL_SL a)
f38b3687c5558128515e34fb85d8b466d22dc300Christian Maeder -> (f -> CASL_SL a)
f38b3687c5558128515e34fb85d8b466d22dc300Christian Maeder -> BASIC_SPEC b s f -> CASL_SL a
0a5571c8adeddd27548445546491725beb224dddChristian Maedersl_basic_spec bf sf ff (Basic_spec l) =
f38b3687c5558128515e34fb85d8b466d22dc300Christian Maeder comp_list $ map (sl_basic_items bf sf ff . item) l
f38b3687c5558128515e34fb85d8b466d22dc300Christian Maedersl_basic_items :: Lattice a => (b -> CASL_SL a)
74d27713392cbbe39ecd72d0ddb0caad16e84555Christian Maeder -> (s -> CASL_SL a)
ef67402074be14deb95e4ff564737d5593144130Klaus Luettich -> (f -> CASL_SL a)
e112e83352048f3db8c8f93ae104193e7338c10fChristian Maeder -> BASIC_ITEMS b s f -> CASL_SL a
ac0bbbcb2774629bb87986e69cf53d3402c5f575Christian Maedersl_basic_items bf sf ff bi = case bi of
aebb0b18fe5e6ba7dd7e4c66a16a905611ef7ba9Christian Maeder Sig_items i -> sl_sig_items sf ff i
e05fd774e0181e93963d4302303b20698603a505Christian Maeder Free_datatype sk l _ -> needsEmptySorts sk
ac0bbbcb2774629bb87986e69cf53d3402c5f575Christian Maeder $ comp_list $ map (sl_datatype_decl . item) l
aebb0b18fe5e6ba7dd7e4c66a16a905611ef7ba9Christian Maeder Sort_gen l _ -> sublogics_max need_se_cons
ac0bbbcb2774629bb87986e69cf53d3402c5f575Christian Maeder $ comp_list $ map (sl_sig_items sf ff . item) l
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder Var_items l _ -> comp_list $ map sl_var_decl l
e05fd774e0181e93963d4302303b20698603a505Christian Maeder Local_var_axioms d l _ -> comp_list
ac0bbbcb2774629bb87986e69cf53d3402c5f575Christian Maeder $ map sl_var_decl d ++ map (sl_formula ff . item) l
f2d9352f2999f82c36b4b65535d14a6a40ae5a82Christian Maeder Axiom_items l _ -> comp_list $ map (sl_formula ff . item) l
340706b6c0c6e3dbacdd7003e20e9cab7f9aa765Christian Maeder Ext_BASIC_ITEMS b -> bf b
483333cb1e873b6d55f5ef0bfbf061861f0493abChristian MaederneedsEmptySorts :: Lattice a => SortsKind -> CASL_SL a -> CASL_SL a
fdb2d618144159395f7bf8ce3327b3c112a17dd3Till MossakowskineedsEmptySorts sk = case sk of
1dfba1f850f6a43094962b459998d1ea11472461Christian Maeder NonEmptySorts -> id
1dfba1f850f6a43094962b459998d1ea11472461Christian Maeder PossiblyEmptySorts -> sublogics_max need_empty_sorts
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maedersl_sig_items :: Lattice a => (s -> CASL_SL a)
fa0f3519d71f719d88577b716b1579776b4a2535Christian Maeder -> (f -> CASL_SL a)
e7757995211bd395dc79d26fe017d99375f7d2a6Christian Maeder -> SIG_ITEMS s f -> CASL_SL a
99afa6000472f3d291fdf9193ea19d334a58658dChristian Maedersl_sig_items sf ff si = case si of
fa0f3519d71f719d88577b716b1579776b4a2535Christian Maeder Sort_items sk l _ -> needsEmptySorts sk
99afa6000472f3d291fdf9193ea19d334a58658dChristian Maeder $ comp_list $ map (sl_sort_item ff . item) l
5bb7eeaca10ea76595229375f907a5a388b7c882Christian Maeder Op_items l _ -> comp_list $ map (sl_op_item ff . item) l
5bb7eeaca10ea76595229375f907a5a388b7c882Christian Maeder Pred_items l _ -> comp_list $ map (sl_pred_item ff . item) l
5bb7eeaca10ea76595229375f907a5a388b7c882Christian Maeder Datatype_items sk l _ -> needsEmptySorts sk
c59d1c38ef94b4fb1c8d9fda9573bc1e1d2801e7Christian Maeder $ comp_list $ map (sl_datatype_decl . item) l
cd36bffee51c77cdadcb9f916b34fa512e311946Christian Maeder Ext_SIG_ITEMS s -> sf s
ac0bbbcb2774629bb87986e69cf53d3402c5f575Christian Maeder{- Subsort_defn needs to compute the expression logic needed seperately
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maederbecause the expressiveness allowed in the formula may be different
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettichfrom more general formulae in the same expression logic -}
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettichsl_sort_item :: Lattice a => (f -> CASL_SL a)
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich -> SORT_ITEM f -> CASL_SL a
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettichsl_sort_item ff si = case si of
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich Subsort_decl {} -> need_sul
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich Subsort_defn _ _ _ f _ -> sublogics_max
36f63902db2b3463faa9f59912ad106e2d5aaa24Klaus Luettich (get_logic_sd ff $ item f)
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich (sublogics_max need_sul
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich (sl_formula ff $ item f))
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich Iso_decl _ _ -> need_sul
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maedersl_op_item :: Lattice a => (f -> CASL_SL a)
e7757995211bd395dc79d26fe017d99375f7d2a6Christian Maeder -> OP_ITEM f -> CASL_SL a
810746aea00b81c1eec27dae84d73a43599ff056Christian Maedersl_op_item ff oi = case oi of
6dc9bc98d0854fe2e3dd3bfc4275096a0c28ee1cChristian Maeder Op_decl _ t l _ -> sublogics_max (sl_op_type t)
8b0f493ae42bad8b94918cc0957f1af57096cda4Felix Reckers (comp_list $ map (sl_op_attr ff) l)
1365c420ef71be3d52796ebd369dc2defdedc822Christian Maeder Op_defn _ h t _ -> sublogics_max (sl_op_head h)
a80c28bb8b7a23ccdf7e08d0fe216fc19cc97273Klaus Luettich (sl_term ff $ item t)
a80c28bb8b7a23ccdf7e08d0fe216fc19cc97273Klaus Luettichsl_op_attr :: Lattice a => (f -> CASL_SL a)
5f0e3e4cb7dd31033c9682cafa712d2a66b2f3bcChristian Maeder -> OP_ATTR f -> CASL_SL a
5f0e3e4cb7dd31033c9682cafa712d2a66b2f3bcChristian Maedersl_op_attr ff oa = case oa of
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder Unit_op_attr t -> sl_term ff t
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maedersl_op_type :: Lattice a => OP_TYPE -> CASL_SL a
d0652648f9879c67a194f8b03baafe2700c68eb4Christian Maedersl_op_type ot = case ot of
210aa1071465039588fa9e38c10e343631c34655Christian Maeder Op_type Partial _ _ _ -> need_part
b1f59a4ea7c96f4c03a4d7cfcb9c5e66871cfbbbChristian Maedersl_op_head :: Lattice a => OP_HEAD -> CASL_SL a
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettichsl_op_head oh = case oh of
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich Op_head Partial _ _ _ -> need_part
4ba08bfca0cc8d9da65397b8dfd2654fdb4c0e62Christian Maedersl_pred_item :: Lattice a => (f -> CASL_SL a)
4ba08bfca0cc8d9da65397b8dfd2654fdb4c0e62Christian Maeder -> PRED_ITEM f -> CASL_SL a
4ba08bfca0cc8d9da65397b8dfd2654fdb4c0e62Christian Maedersl_pred_item ff i = case i of
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich Pred_decl {} -> need_pred
1365c420ef71be3d52796ebd369dc2defdedc822Christian Maeder Pred_defn _ _ f _ -> sublogics_max need_pred (sl_formula ff $ item f)
308834907a120fd8771e18292ed2ca9cd767c12dChristian Maedersl_datatype_decl :: Lattice a => DATATYPE_DECL -> CASL_SL a
1365c420ef71be3d52796ebd369dc2defdedc822Christian Maedersl_datatype_decl (Datatype_decl _ l _) =
83394c6b6e6de128e71b67c9251ed7a84485d082Christian Maeder comp_list $ map (sl_alternative . item) l
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maedersl_alternative :: Lattice a => ALTERNATIVE -> CASL_SL a
1aee4aaddde105264c1faf394d88e302c05094ffChristian Maedersl_alternative a = case a of
1aee4aaddde105264c1faf394d88e302c05094ffChristian Maeder Alt_construct Total _ l _ -> comp_list $ map sl_components l
2d130d212db7208777ca896a7ecad619a8944971Christian Maeder Alt_construct Partial _ _ _ -> need_part
10883d13973c46cac98964b66ace7a52b2d059abChristian Maeder Subsorts _ _ -> need_sul
83394c6b6e6de128e71b67c9251ed7a84485d082Christian Maedersl_components :: Lattice a => COMPONENTS -> CASL_SL a
68d10d143f29fcff3c637ba24f90e983995ceae6Christian Maedersl_components c = case c of
e7757995211bd395dc79d26fe017d99375f7d2a6Christian Maeder Cons_select Partial _ _ _ -> need_part
340706b6c0c6e3dbacdd7003e20e9cab7f9aa765Christian Maedersl_var_decl :: Lattice a => VAR_DECL -> CASL_SL a
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettichsl_var_decl _ = bottom
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder{- without subsorts casts are trivial and would not even require
68d10d143f29fcff3c637ba24f90e983995ceae6Christian Maeder need_part, but testing sortOfTerm is not save for formulas in basic specs
e1559d046eb2c6dde0e6e272b37b6756eac0e8adChristian Maeder that are only parsed (and resolved) but not enriched with sorts -}
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian MaederslRecord :: Lattice a => (f -> CASL_SL a) -> Record f (CASL_SL a) (CASL_SL a)
2c619a4dfdc1df27573eba98e81ed1ace906941dChristian MaederslRecord ff = (constRecord ff comp_list bottom)
5580ab3e64410186ccd36cde8a94282d8757ac0dChristian Maeder { foldPredication = \ _ _ l _ -> comp_list $ need_pred : l
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder , foldEquation = \ _ t _ u _ -> comp_list [need_eq, t, u]
e284004f10a315dbdb624c8b2522f65d485eaa48Martin Kühl , foldSort_gen_ax = \ _ constraints _ ->
e284004f10a315dbdb624c8b2522f65d485eaa48Martin Kühl case recover_Sort_gen_ax constraints of
e284004f10a315dbdb624c8b2522f65d485eaa48Martin Kühl (_, ops, m) -> case (m, filter (\ o -> case o of
e284004f10a315dbdb624c8b2522f65d485eaa48Martin Kühl Op_name _ -> True
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Qual_op_name n _ _ ->
50515239e7e190f4a34ca581dd685d002148fbddChristian Maeder not (isInjName n)) ops) of
50515239e7e190f4a34ca581dd685d002148fbddChristian Maeder ([], []) -> need_se_cons
0b349288edfa50fdf38fda1a14e1562d03f92574Christian Maeder ([], _) -> need_e_cons
0b349288edfa50fdf38fda1a14e1562d03f92574Christian Maeder (_, []) -> need_s_cons
0b349288edfa50fdf38fda1a14e1562d03f92574Christian Maeder _ -> need_cons
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder , foldQuantPred = \ _ _ _ f -> sublogics_max need_pred f
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder , foldCast = \ _ t _ _ -> sublogics_max need_part t
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maedersl_term :: Lattice a => (f -> CASL_SL a) -> TERM f -> CASL_SL a
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maedersl_term = foldTerm . slRecord
8b4c68db8b465107cabef8b9cd5b6bc216e1b156Till Mossakowskisl_formula :: Lattice a => (f -> CASL_SL a)
8b4c68db8b465107cabef8b9cd5b6bc216e1b156Till Mossakowski -> FORMULA f -> CASL_SL a
bcaf979d9babe6346aa343687aa7d596e2894cccPaolo Torrinisl_formula ff f = sublogics_max (get_logic ff f) (sl_form ff f)
bcaf979d9babe6346aa343687aa7d596e2894cccPaolo Torrinisl_form :: Lattice a => (f -> CASL_SL a)
5ce19352a9cc47d982819cc889a71cd0a61ac171Christian Maeder -> FORMULA f -> CASL_SL a
5ce19352a9cc47d982819cc889a71cd0a61ac171Christian Maedersl_form = foldFormula . slRecord
bcaf979d9babe6346aa343687aa7d596e2894cccPaolo Torrinisl_symb_items :: Lattice a => SYMB_ITEMS -> CASL_SL a
23ab8855c58adfbd03a0730584b917b24c603901Christian Maedersl_symb_items (Symb_items k l _) = sublogics_max (sl_symb_kind k)
df29370ae8d8b41587957f6bcdcb43a3f1927e47Christian Maeder (comp_list $ map sl_symb l)
e50e41135ece589f7202bd4ef8d6b97531c2a56eKlaus Luettichsl_symb_kind :: Lattice a => SYMB_KIND -> CASL_SL a
47b0e9f3cb008cb7997f4e3bae26e4d62dcc887aChristian Maedersl_symb_kind pk = case pk of
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder Preds_kind -> need_pred
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maedersl_symb :: Lattice a => SYMB -> CASL_SL a
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maedersl_symb s = case s of
99afa6000472f3d291fdf9193ea19d334a58658dChristian Maeder Symb_id _ -> bottom
43b4c41fbb07705c9df321221ab9cb9832460407Christian Maeder Qual_id _ t _ -> sl_type t
d5d349836d8b1fa93ea49a59d977b106c6e9233bKlaus Luettichsl_type :: Lattice a => TYPE -> CASL_SL a
d5d349836d8b1fa93ea49a59d977b106c6e9233bKlaus Luettichsl_type ty = case ty of
88318aafc287e92931dceffbb943d58a9310001dChristian Maeder O_type t -> sl_op_type t
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder P_type _ -> need_pred
43b4c41fbb07705c9df321221ab9cb9832460407Christian Maedersl_symb_map_items :: Lattice a => SYMB_MAP_ITEMS -> CASL_SL a
e62d49c0dc2893da75faad896bd135e2e9a7087bKlaus Luettichsl_symb_map_items (Symb_map_items k l _) = sublogics_max (sl_symb_kind k)
9096f6c6aaded6cd8288656ceccd4c7b3bd0747eChristian Maeder (comp_list $ map sl_symb_or_map l)
e112e83352048f3db8c8f93ae104193e7338c10fChristian Maedersl_symb_or_map :: Lattice a => SYMB_OR_MAP -> CASL_SL a
e112e83352048f3db8c8f93ae104193e7338c10fChristian Maedersl_symb_or_map syms = case syms of
e62d49c0dc2893da75faad896bd135e2e9a7087bKlaus Luettich Symb s -> sl_symb s
e62d49c0dc2893da75faad896bd135e2e9a7087bKlaus Luettich Symb_map s t _ -> sublogics_max (sl_symb s) (sl_symb t)
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder{- the maps have no influence since all sorts, ops, preds in them
e112e83352048f3db8c8f93ae104193e7338c10fChristian Maedermust also appear in the signatures, so any features needed by
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maederthem will be included by just checking the signatures -}
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maedersl_sign :: Lattice a => (e -> CASL_SL a) -> Sign f e -> CASL_SL a
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder let rel = sortRel s
1aee4aaddde105264c1faf394d88e302c05094ffChristian Maeder subs | Rel.noPairs rel = bottom
7059fdf30dd36a0cf809b6c293cd3dc106e3ad3dEwaryst Schulz | otherwise = need_sub
7059fdf30dd36a0cf809b6c293cd3dc106e3ad3dEwaryst Schulz esorts = if Set.null $ emptySortSet s then bottom
7059fdf30dd36a0cf809b6c293cd3dc106e3ad3dEwaryst Schulz else need_empty_sorts
363939beade943a02b31004cea09dec34fa8a6d9Christian Maeder preds = if MapSet.null $ predMap s then bottom else need_pred
c72c1e75a969ff4c336e77481c2a8e42603f13eeChristian Maeder partial = if any isPartial $ Set.toList
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder $ MapSet.elems $ opMap s then need_part else bottom
fdef3358918491badb0e29e42b5d3b5a01950716Christian Maeder in comp_list [subs, esorts, preds, partial, f $ extendedInfo s]
6ff7a91875597d6e4dfaa68c79187d01473e8341Christian Maedersl_sentence :: Lattice a => (f -> CASL_SL a) -> FORMULA f -> CASL_SL a
6ff7a91875597d6e4dfaa68c79187d01473e8341Christian Maedersl_sentence = sl_formula
fdef3358918491badb0e29e42b5d3b5a01950716Christian Maedersl_morphism :: Lattice a => (e -> CASL_SL a) -> Morphism f e m -> CASL_SL a
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maedersl_morphism f m = sublogics_max (sl_sign f $ msource m) (sl_sign f $ mtarget m)
88318aafc287e92931dceffbb943d58a9310001dChristian Maedersl_symbol :: Lattice a => Symbol -> CASL_SL a
7767474aba4fa2dc51a6c68017d3bcef3b773001Christian Maedersl_symbol (Symbol _ t) = sl_symbtype t
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maedersl_symbtype :: Lattice a => SymbType -> CASL_SL a
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maedersl_symbtype st = case st of
340706b6c0c6e3dbacdd7003e20e9cab7f9aa765Christian Maeder OpAsItemType t -> sl_optype t
88318aafc287e92931dceffbb943d58a9310001dChristian Maeder PredAsItemType _ -> need_pred
fdb2d618144159395f7bf8ce3327b3c112a17dd3Till Mossakowskisl_optype :: Lattice a => OpType -> CASL_SL a
e7757995211bd395dc79d26fe017d99375f7d2a6Christian Maedersl_optype = sl_opkind . opKind
473bc1f3f3443f18e0ee83e4642fab42183470f2Christian Maedersl_opkind :: Lattice a => OpKind -> CASL_SL a
473bc1f3f3443f18e0ee83e4642fab42183470f2Christian Maedersl_opkind fk = case fk of
6e049108aa87dc46bcff96fae50a4625df1d9648Klaus Luettich Partial -> need_part
f4505a64a089693012a3f5c3b1f12a82cd7a2a5aKlaus Luettich{- ----------------------------------------------------------------------------
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maederprojection functions
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder---------------------------------------------------------------------------- -}
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maedersl_in :: Lattice a => CASL_SL a -> CASL_SL a -> Bool
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maedersl_in given new = sublogics_max given new == given
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maederin_x :: Lattice a => CASL_SL a -> b -> (b -> CASL_SL a) -> Bool
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maederin_x l x f = sl_in l (f x)
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder-- process Annoted type like simple type, simply keep all annos
1a6464613c59e35072b90ca296ae402cbe956144Christian Maederpr_annoted :: CASL_SL s -> (CASL_SL s -> a -> Maybe a)
8b767d09a78927b111f5596fdff9ca7d2c1a439fChristian Maeder -> Annoted a -> Maybe (Annoted a)
8b767d09a78927b111f5596fdff9ca7d2c1a439fChristian Maederpr_annoted sl f a =
8b767d09a78927b111f5596fdff9ca7d2c1a439fChristian Maeder fmap (`replaceAnnoted` a) $ f sl (item a)
8b767d09a78927b111f5596fdff9ca7d2c1a439fChristian Maeder{- project annoted type, by-producing a [SORT]
8b767d09a78927b111f5596fdff9ca7d2c1a439fChristian Maederused for projecting datatypes: sometimes it is necessary to
8b767d09a78927b111f5596fdff9ca7d2c1a439fChristian Maederintroduce a SORT_DEFN for a datatype that was erased
0be0db405c49906bd7057255069bf6df53395ac9Klaus Luettichcompletely, for example by only having partial constructors
0be0db405c49906bd7057255069bf6df53395ac9Klaus Luettichand partiality forbidden in the desired sublogic - the sort
0be0db405c49906bd7057255069bf6df53395ac9Klaus Luettichname may however still be needed for formulas because it can
0be0db405c49906bd7057255069bf6df53395ac9Klaus Luettichappear there like in (forall x,y:Datatype . x=x), a formula
0be0db405c49906bd7057255069bf6df53395ac9Klaus Luettichthat does not use partiality (does not use any constructor
0be0db405c49906bd7057255069bf6df53395ac9Klaus Luettichor selector) -}
0be0db405c49906bd7057255069bf6df53395ac9Klaus Luettichpr_annoted_dt :: CASL_SL s
0be0db405c49906bd7057255069bf6df53395ac9Klaus Luettich -> (CASL_SL s -> a -> (Maybe a, [SORT]))
0be0db405c49906bd7057255069bf6df53395ac9Klaus Luettich -> Annoted a -> (Maybe (Annoted a), [SORT])
0be0db405c49906bd7057255069bf6df53395ac9Klaus Luettichpr_annoted_dt sl f a =
5818d884784339c1b8aa6c6d972bad4eafd36ccbKlaus Luettich let (res, lst) = f sl (item a)
0be0db405c49906bd7057255069bf6df53395ac9Klaus Luettich in (fmap (`replaceAnnoted` a) res
0be0db405c49906bd7057255069bf6df53395ac9Klaus Luettich-- keep an element if its computed sublogic is in the given sublogic
0be0db405c49906bd7057255069bf6df53395ac9Klaus Luettichpr_check :: Lattice a => CASL_SL a -> (b -> CASL_SL a)
0be0db405c49906bd7057255069bf6df53395ac9Klaus Luettich -> b -> Maybe b
438f9bd974c8e668203e636b0f2bc80c589af043Klaus Luettichpr_check l f e = if in_x l e f then Just e else Nothing
9e748851c150e1022fb952bab3315e869aaf0214Christian MaedercheckRecord :: CASL_SL a -> (CASL_SL a -> f -> Maybe (FORMULA f))
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder -> Record f (FORMULA f) (TERM f)
88318aafc287e92931dceffbb943d58a9310001dChristian MaedercheckRecord l ff = (mapRecord id)
438f9bd974c8e668203e636b0f2bc80c589af043Klaus Luettich { foldExtFORMULA = \ o _ -> case o of
88318aafc287e92931dceffbb943d58a9310001dChristian Maeder ExtFORMULA f -> fromMaybe (error "checkRecord") $ ff l f
f78ce817f35574674d54e30ad1861a9b4ced20caChristian MaedertoCheck :: Lattice a => CASL_SL a
f78ce817f35574674d54e30ad1861a9b4ced20caChristian Maeder -> (CASL_SL a -> f -> Maybe (FORMULA f))
f78ce817f35574674d54e30ad1861a9b4ced20caChristian Maeder -> f -> CASL_SL a
f78ce817f35574674d54e30ad1861a9b4ced20caChristian MaedertoCheck l ff = maybe top (const l) . ff l
f78ce817f35574674d54e30ad1861a9b4ced20caChristian Maederpr_formula :: Lattice a => (CASL_SL a -> f -> Maybe (FORMULA f))
f78ce817f35574674d54e30ad1861a9b4ced20caChristian Maeder -> CASL_SL a -> FORMULA f -> Maybe (FORMULA f)
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maederpr_formula ff l =
89c9d707aa817684b88036a2dad66c3437840677Heng Jiang fmap (foldFormula $ checkRecord l ff)
f78ce817f35574674d54e30ad1861a9b4ced20caChristian Maeder . pr_check l (sl_formula $ toCheck l ff)
f78ce817f35574674d54e30ad1861a9b4ced20caChristian Maederpr_term :: Lattice a => (CASL_SL a -> f -> Maybe (FORMULA f))
f041c9a6bda23de33a38490e35b831ae18d96b45Christian Maeder -> CASL_SL a -> TERM f -> Maybe (TERM f)
f041c9a6bda23de33a38490e35b831ae18d96b45Christian Maederpr_term ff l =
f041c9a6bda23de33a38490e35b831ae18d96b45Christian Maeder fmap (foldTerm $ checkRecord l ff)
bea81dabd203833818cb4a5f3758977c695728cdHeng Jiang . pr_check l (sl_term $ toCheck l ff)
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder-- make full Annoted Sig_items out of a SORT list
49d647f58ec5bf482da541eec62f531848c49036Christian Maederpr_make_sorts :: [SORT] -> Annoted (BASIC_ITEMS b s f)
f9442174f64331ccf0bf08178632af7302ccfc96Christian Maederpr_make_sorts s =
f9442174f64331ccf0bf08178632af7302ccfc96Christian Maeder Annoted (Sig_items (Sort_items NonEmptySorts
f9442174f64331ccf0bf08178632af7302ccfc96Christian Maeder [Annoted (Sort_decl s nullRange) nullRange [] []]
c802a1041ed9251f8ad79139454267e802900e2aChristian Maeder nullRange [] []
bf7b17b0e19362e9228672782218678cab275d1eDominik Luecke{- when processing BASIC_SPEC, add a Sort_decl in front for sorts
bf7b17b0e19362e9228672782218678cab275d1eDominik Lueckedefined by DATATYPE_DECLs that had to be removed completely,
bf7b17b0e19362e9228672782218678cab275d1eDominik Lueckeotherwise formulas might be broken by the missing sorts, thus
bf7b17b0e19362e9228672782218678cab275d1eDominik Lueckebreaking the projection -}
bf7b17b0e19362e9228672782218678cab275d1eDominik Lueckepr_basic_spec :: Lattice a =>
bf7b17b0e19362e9228672782218678cab275d1eDominik Luecke (CASL_SL a -> b -> (Maybe (BASIC_ITEMS b s f), [SORT]))
bf7b17b0e19362e9228672782218678cab275d1eDominik Luecke -> (CASL_SL a -> s -> (Maybe (SIG_ITEMS s f), [SORT]))
75b0c0c2cbfb7edd3f4c0555227aabbe6c1aa195Christian Maeder -> (CASL_SL a -> f -> Maybe (FORMULA f))
bf7b17b0e19362e9228672782218678cab275d1eDominik Luecke -> CASL_SL a -> BASIC_SPEC b s f -> BASIC_SPEC b s f
pr_pred_map l x = if has_pred l then x else Map.empty
pr_op_map = Map.filterWithKey . pr_op_map_entry