StaticAna.hs revision ad270004874ce1d0697fb30d7309f180553bb315
c63ebf815c8a874525cf18670ad74847f7fc7b26Christian MaederModule : $Header$
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaederDescription : CASL static analysis for basic specifications
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian MaederCopyright : (c) Christian Maeder and Uni Bremen 2002-2005
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaederLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian MaederMaintainer : maeder@tzi.de
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian MaederStability : provisional
43b4c41fbb07705c9df321221ab9cb9832460407Christian MaederPortability : portable
f4a2a20e49f41b2afa657e5e64d9e349c7faa091Christian MaederCASL static analysis for basic specifications
c9a7e6af169a2adfb92f42331cd578065ed83a2bChristian MaederFollows Chaps. III:2 and III:3 of the CASL Reference Manual.
e7757995211bd395dc79d26fe017d99375f7d2a6Christian MaederThe static analysis takes an abstract syntax tree of a basic specification
e7757995211bd395dc79d26fe017d99375f7d2a6Christian Maederand outputs a signature and a set of formulas, while checking that
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder- all sorts used in operation and predicate declarations have been declared
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder- all sorts, operation and predicate symbols used in formulas have
a1ed34933c266ce85066acb0d7b20c90cb8eb213Christian Maeder been declared
c0c2380bced8159ff0297ece14eba948bd236471Christian Maeder- formulas type-check
404166b9366552e9ec5abb87a37c76ec8a815fb7Klaus LuettichThe formulas are returned with fully-qualified variables, operation
b1f59a4ea7c96f4c03a4d7cfcb9c5e66871cfbbbChristian Maederand predicate symbols.
4d56f2fa72e4aec20eb827c11ed49c8cbb7014bdChristian MaederThe static analysis functions are parameterized with functions for
4cb215739e9ab13447fa21162482ebe485b47455Christian Maedertreating CASL extensions, that is, additional basic items, signature
8ef75f1cc0437656bf622cec5ac9e8ea221da8f2Christian Maederitems and formulas.
dcbd32289a7bdf1e6edd06c6ab0698c6a9dbf37aChristian Maederimport qualified Data.Map as Map
f4a2a20e49f41b2afa657e5e64d9e349c7faa091Christian Maederimport qualified Data.Set as Set
f4a2a20e49f41b2afa657e5e64d9e349c7faa091Christian Maederimport qualified Common.Lib.Rel as Rel
8b767d09a78927b111f5596fdff9ca7d2c1a439fChristian MaedercheckPlaces :: [SORT] -> Id -> [Diagnosis]
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaedercheckPlaces args i =
d54cd08a4cfa26256c38d8ed12c343adbfe1a0e3Christian Maeder if let n = placeCount i in n == 0 || n == length args then []
308834907a120fd8771e18292ed2ca9cd767c12dChristian Maeder else [mkDiag Error "wrong number of places" i]
bab2d88d650448628730ed3b65c9f99c52500e8cChristian MaedercheckWithVars :: Map.Map SIMPLE_ID a -> Id -> [Diagnosis]
8cacad2a09782249243b80985f28e9387019fe40Christian MaedercheckWithVars m i@(Id ts _ _) = if isSimpleId i then
6a2dad705deefd1b7a7e09b84fd2d75f2213be47Christian Maeder case Map.lookup (head ts) m of
a7c27282e71cf4505026645f96d4f5cb8a284e32Christian Maeder Nothing -> []
363939beade943a02b31004cea09dec34fa8a6d9Christian Maeder Just _ -> alsoWarning "variable" i
6aea82c63ba1d2efc0329bc784a14e521469ec20Christian MaederaddOp :: Annoted a -> OpType -> Id -> State (Sign f e) ()
4ba08bfca0cc8d9da65397b8dfd2654fdb4c0e62Christian MaederaddOp a ty i =
feca1d35123d8c31aee238c9ce79947b0bf65494Christian Maeder do checkSorts (opRes ty : opArgs ty)
f1541d4a151dbd08002dbd14e7eb1d5dde253689Christian Maeder let m = opMap e
db675e8302ddb0d6528088ce68f5e98a00e890e3Christian Maeder check = addDiags $ checkPlaces (opArgs ty) i
f1541d4a151dbd08002dbd14e7eb1d5dde253689Christian Maeder ++ checkWithOtherMap "predicate" (predMap e) i
6dc9bc98d0854fe2e3dd3bfc4275096a0c28ee1cChristian Maeder ++ checkWithVars (varMap e) i
6dc9bc98d0854fe2e3dd3bfc4275096a0c28ee1cChristian Maeder ++ checkNamePrefix i
6dc9bc98d0854fe2e3dd3bfc4275096a0c28ee1cChristian Maeder store = do put e { opMap = addOpTo i ty m }
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder addDiags [mkDiag Hint "redeclared op" i]
c0c2380bced8159ff0297ece14eba948bd236471Christian Maeder else case opKind ty of
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder Partial -> if Set.member ty {opKind = Total} l then
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder addDiags [mkDiag Warning "partially redeclared" i]
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder else store >> check
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder Total -> do store
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder if Set.member ty {opKind = Partial} l then
9e748851c150e1022fb952bab3315e869aaf0214Christian Maeder addDiags [mkDiag Hint "redeclared as total" i]
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian Maeder addAnnoSet a $ Symbol i $ OpAsItemType ty
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian MaederaddAssocOp :: OpType -> Id -> State (Sign f e) ()
ca074a78b8dcccbb8c419586787882f98d0c6163Christian MaederaddAssocOp ty i = do
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian Maeder put e { assocOps = addOpTo i ty $ assocOps e
a5e5b8c3e5c11177e5034ef2423813a5d28979edChristian Maeder , globAnnos = updAssocMap (addAssocId i) $ globAnnos e
2d130d212db7208777ca896a7ecad619a8944971Christian MaederupdateExtInfo :: (e -> Result e) -> State (Sign f e) ()
51d769d55d88dfa88bdf54bee78d8fa85a2deba8Christian MaederupdateExtInfo upd = do
a42fbfe7becf0eae2d624123eb0db73a794593f0Christian Maeder let re = upd $ extendedInfo s
a42fbfe7becf0eae2d624123eb0db73a794593f0Christian Maeder case maybeResult re of
b363eb04791e7f735633b9b4088502c2bc50ebfcChristian Maeder Nothing -> return ()
a42fbfe7becf0eae2d624123eb0db73a794593f0Christian Maeder Just e -> put s { extendedInfo = e }
1cd4f6541984962658add5cfaa9f28a93879881bChristian Maeder addDiags $ diags re
2d130d212db7208777ca896a7ecad619a8944971Christian MaederaddPred :: Annoted a -> PredType -> Id -> State (Sign f e) ()
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian MaederaddPred a ty i =
6ff7a91875597d6e4dfaa68c79187d01473e8341Christian Maeder do checkSorts $ predArgs ty
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian Maeder let m = predMap e
a9b59eb2ce961014974276cdae0e9df4419bd212Christian Maeder addDiags [mkDiag Hint "redeclared pred" i]
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian Maeder else do put e { predMap = Map.insert i (Set.insert ty l) m }
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian Maeder addDiags $ checkPlaces (predArgs ty) i
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian Maeder ++ checkWithOtherMap "operation" (opMap e) i
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian Maeder ++ checkWithVars (varMap e) i
6a79849bed67264c396dddb3e9c184bdfc1a1bc9Christian Maeder ++ checkNamePrefix i
a3c6d8e0670bf2aa71bc8e2a3b1f45d56dd65e4cChristian Maeder addAnnoSet a $ Symbol i $ PredAsItemType ty
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian MaederallOpIds :: Sign f e -> Set.Set Id
ca074a78b8dcccbb8c419586787882f98d0c6163Christian MaederallOpIds = Rel.keysSet . opMap
ca074a78b8dcccbb8c419586787882f98d0c6163Christian MaederaddAssocs :: Sign f e -> GlobalAnnos -> GlobalAnnos
ca074a78b8dcccbb8c419586787882f98d0c6163Christian MaederaddAssocs e = updAssocMap (\ m -> foldr addAssocId m $ Map.keys $ assocOps e)
4017ebc0f692820736d796af3110c3b3018c108aChristian MaederupdAssocMap :: (AssocMap -> AssocMap) -> GlobalAnnos -> GlobalAnnos
b568982efd0997d877286faa592d81b03c8c67b8Christian MaederupdAssocMap f ga = ga { assoc_annos = f $ assoc_annos ga }
0be0db405c49906bd7057255069bf6df53395ac9Klaus LuettichaddAssocId :: Id -> AssocMap -> AssocMap
ca074a78b8dcccbb8c419586787882f98d0c6163Christian MaederaddAssocId i m = case Map.lookup i m of
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder Nothing -> Map.insert i ALeft m
f2f9df2e17e70674f0bf426ed1763c973ee4cde0Christian MaederformulaIds :: Sign f e -> Set.Set Id
d946c1bfdd7d58aa7c023efe864d5999eb44a61bChristian MaederformulaIds e = let ops = allOpIds e in
d946c1bfdd7d58aa7c023efe864d5999eb44a61bChristian Maeder Set.fromDistinctAscList (map simpleIdToId $ Map.keys $ varMap e)
d946c1bfdd7d58aa7c023efe864d5999eb44a61bChristian MaederallPredIds :: Sign f e -> Set.Set Id
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian MaederallPredIds = Rel.keysSet . predMap
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian MaederaddSentences :: [Named (FORMULA f)] -> State (Sign f e) ()
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian MaederaddSentences ds =
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maeder put e { sentences = reverse ds ++ sentences e }
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder-- * traversing all data types of the abstract syntax
ca074a78b8dcccbb8c419586787882f98d0c6163Christian Maederana_BASIC_SPEC :: Pretty f => Min f e
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder -> Ana b b s f e -> Ana s b s f e -> Mix b s f e
3e8b136f23ed57d40ee617f49bcac37830b58cabChristian Maeder -> BASIC_SPEC b s f -> State (Sign f e) (BASIC_SPEC b s f)
f1541d4a151dbd08002dbd14e7eb1d5dde253689Christian Maederana_BASIC_SPEC mef ab anas mix (Basic_spec al) = fmap Basic_spec $
6dc9bc98d0854fe2e3dd3bfc4275096a0c28ee1cChristian Maeder mapAnM (ana_BASIC_ITEMS mef ab anas mix) al
e6d5dbbc3308f05197868806e0b860f4f53875f1Christian Maeder-- looseness of a datatype
363939beade943a02b31004cea09dec34fa8a6d9Christian Maederdata GenKind = Free | Generated | Loose deriving (Show, Eq, Ord)
eb74267cf39e4e95f9eeb5c765f4c8dac33971b4Christian MaedermkForall :: [VAR_DECL] -> FORMULA f -> Range -> FORMULA f
eb74267cf39e4e95f9eeb5c765f4c8dac33971b4Christian MaedermkForall vl f ps = if null vl then f else
e4f4d096e5e6d60dd91c746d0e833d0ac7a29c50Christian Maeder Quantification Universal vl f ps
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaederunionGenAx :: [GenAx] -> GenAx
f1541d4a151dbd08002dbd14e7eb1d5dde253689Christian MaederunionGenAx = foldr ( \ (s1, r1, f1) (s2, r2, f2) ->
6cd33d6101fb1b93baa6d86fac158af18a115108Christian Maeder Set.union f1 f2)) emptyGenAx
6cd33d6101fb1b93baa6d86fac158af18a115108Christian Maederana_BASIC_ITEMS :: Pretty f => Min f e -> Ana b b s f e -> Ana s b s f e
6cd33d6101fb1b93baa6d86fac158af18a115108Christian Maeder -> Mix b s f e -> BASIC_ITEMS b s f
6cd33d6101fb1b93baa6d86fac158af18a115108Christian Maeder -> State (Sign f e) (BASIC_ITEMS b s f)
b2ac5a92cf36382e8deea5661c1964566caf72b3Christian Maederana_BASIC_ITEMS mef ab anas mix bi =
b2ac5a92cf36382e8deea5661c1964566caf72b3Christian Maeder Sig_items sis -> fmap Sig_items $
b2ac5a92cf36382e8deea5661c1964566caf72b3Christian Maeder ana_SIG_ITEMS mef anas mix Loose sis
6cd33d6101fb1b93baa6d86fac158af18a115108Christian Maeder Free_datatype al ps ->
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder do mapM_ (\ i -> case item i of
10883d13973c46cac98964b66ace7a52b2d059abChristian Maeder Datatype_decl s _ _ -> addSort i s) al
c9a7e6af169a2adfb92f42331cd578065ed83a2bChristian Maeder mapAnM (ana_DATATYPE_DECL Free) al
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder toSortGenAx ps True $ getDataGenSig al
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder closeSubsortRel
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Sort_gen al ps ->
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder do (gs,ul) <- ana_Generated mef anas mix al
f1a913f880e409e7327b5deae95738b5448379a1Christian Maeder toSortGenAx ps False $ unionGenAx gs
f1a913f880e409e7327b5deae95738b5448379a1Christian Maeder return $ Sort_gen ul ps
f1a913f880e409e7327b5deae95738b5448379a1Christian Maeder Var_items il _ ->
f1a913f880e409e7327b5deae95738b5448379a1Christian Maeder do mapM_ addVars il
c9a7e6af169a2adfb92f42331cd578065ed83a2bChristian Maeder Local_var_axioms il afs ps ->
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder do e <- get -- save
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder mapM_ addVars il
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder vds <- gets envDiags
93f5b72fdb9ee734caa750b43dd79bbb590dcd73Christian Maeder put e { envDiags = vds } -- restore with shadowing warnings
93f5b72fdb9ee734caa750b43dd79bbb590dcd73Christian Maeder let (es, resFs, anaFs) = foldr ( \ f (dss, ress, ranas) ->
93f5b72fdb9ee734caa750b43dd79bbb590dcd73Christian Maeder let Result ds m = anaForm mef mix sign $ item f
308834907a120fd8771e18292ed2ca9cd767c12dChristian Maeder Nothing -> (ds ++ dss, ress, ranas)
06dd4e7c29f33f6122a910719e3bd9062256e397Andy Gimblett Just (resF, anaF) ->
254df6f22d01eacf7c57b85729e0445747b630d9Christian Maeder (ds ++ dss, f {item = resF} : ress,
4ba08bfca0cc8d9da65397b8dfd2654fdb4c0e62Christian Maeder f {item = anaF} : ranas))
bff4b3f816be4c1e1d8ded76f1d5af786839e1a9Christian Maeder ([], [], []) afs
5b818f10e11fc79def1fdd5c8a080d64a6438d87Christian Maeder fufs = map (mapAn (\ f -> let
8b0f493ae42bad8b94918cc0957f1af57096cda4Felix Reckers vs = map ( \ (v, s) ->
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Var_decl [v] s ps)
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder in stripQuant $ mkForall (vs ++ il) f ps))
140287998aa8592c9c403bd9e308e447ba92ae11Christian Maeder sens = map ( \ a -> NamedSen (getRLabel a)
c208973c890b8f993297720fd0247bc7481d4304Christian Maeder (notImplied a) False $ item a) fufs
aded505f9b42cc38975559c2a5d175ae95de436bChristian Maeder addSentences sens
3e8b136f23ed57d40ee617f49bcac37830b58cabChristian Maeder return $ Local_var_axioms il resFs ps
8b0f493ae42bad8b94918cc0957f1af57096cda4Felix Reckers Axiom_items afs ps ->
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder do sign <- get
9e748851c150e1022fb952bab3315e869aaf0214Christian Maeder let (es, resFs, anaFs) = foldr ( \ f (dss, ress, ranas) ->
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder let Result ds m = anaForm mef mix
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder sign $ item f
383aa66e5142365fe9b1f88b18c1da5b27cc8c04Christian Maeder Nothing -> (ds ++ dss, ress, ranas)
383aa66e5142365fe9b1f88b18c1da5b27cc8c04Christian Maeder Just (resF, anaF) ->
383aa66e5142365fe9b1f88b18c1da5b27cc8c04Christian Maeder (ds ++ dss, f {item = resF} : ress,
383aa66e5142365fe9b1f88b18c1da5b27cc8c04Christian Maeder f {item = anaF} : ranas))
aded505f9b42cc38975559c2a5d175ae95de436bChristian Maeder ([], [], []) afs
aded505f9b42cc38975559c2a5d175ae95de436bChristian Maeder fufs = map (mapAn (\ f -> let
aded505f9b42cc38975559c2a5d175ae95de436bChristian Maeder vs = map ( \ (v, s) ->
aded505f9b42cc38975559c2a5d175ae95de436bChristian Maeder Var_decl [v] s ps)
aded505f9b42cc38975559c2a5d175ae95de436bChristian Maeder in stripQuant $ mkForall vs f ps)) anaFs
383aa66e5142365fe9b1f88b18c1da5b27cc8c04Christian Maeder sens = map ( \ a -> NamedSen (getRLabel a)
383aa66e5142365fe9b1f88b18c1da5b27cc8c04Christian Maeder (notImplied a) False $ item a) fufs
a14767aeac3e78ed100f5b75e210ba563ee10dbaChristian Maeder addSentences sens
a14767aeac3e78ed100f5b75e210ba563ee10dbaChristian Maeder return $ Axiom_items resFs ps
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder Ext_BASIC_ITEMS b -> fmap Ext_BASIC_ITEMS $ ab mix b
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian MaedermapAn :: (a -> b) -> Annoted a -> Annoted b
54ea981a0503c396c2923a1c06421c6235baf27fChristian MaedermapAn f an = replaceAnnoted (f $ item an) an
54ea981a0503c396c2923a1c06421c6235baf27fChristian Maedertype GenAx = (Set.Set SORT, Rel.Rel SORT, Set.Set Component)
aded505f9b42cc38975559c2a5d175ae95de436bChristian MaederemptyGenAx :: GenAx
697e63e30aa3c309a1ef1f9357745111f8dfc5a9Christian MaederemptyGenAx = (Set.empty, Rel.empty, Set.empty)
aded505f9b42cc38975559c2a5d175ae95de436bChristian MaedertoSortGenAx :: Range -> Bool -> GenAx -> State (Sign f e) ()
f9e0b18852b238ddb649d341194e05d7200d1bbeChristian MaedertoSortGenAx ps isFree (sorts, rel, ops) = do
819e29dba060687cf391e444e0f6ff88c1908cc3Christian Maeder let sortList = Set.toList sorts
819e29dba060687cf391e444e0f6ff88c1908cc3Christian Maeder opSyms = map ( \ c -> let ide = compId c in Qual_op_name ide
819e29dba060687cf391e444e0f6ff88c1908cc3Christian Maeder (toOP_TYPE $ compType c) $ posOfId ide) $ Set.toList ops
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder injSyms = map ( \ (s, t) -> let p = posOfId s in
254df6f22d01eacf7c57b85729e0445747b630d9Christian Maeder Qual_op_name injName
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder (Op_type Total [s] t p) p) $ Rel.toList
254df6f22d01eacf7c57b85729e0445747b630d9Christian Maeder resType _ (Op_name _) = False
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder resType s (Qual_op_name _ t _) = res_OP_TYPE t ==s
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder getIndex s = maybe (-1) id $ findIndex (==s) sortList
254df6f22d01eacf7c57b85729e0445747b630d9Christian Maeder addIndices (Op_name _) =
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder error "CASL/StaticAna: Internal error in function addIndices"
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder addIndices os@(Qual_op_name _ t _) =
aded505f9b42cc38975559c2a5d175ae95de436bChristian Maeder (os,map getIndex $ args_OP_TYPE t)
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder collectOps s =
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder Constraint s (map addIndices $ filter (resType s)
ac34194a668399bb8ef238da77c3a09e93fb253bChristian Maeder (opSyms ++ injSyms)) s
4fc9de0da898448f1d3597ebbd8c04a066464c21Christian Maeder constrs = map collectOps sortList
aded505f9b42cc38975559c2a5d175ae95de436bChristian Maeder f = Sort_gen_ax constrs isFree
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder if null sortList then
c208973c890b8f993297720fd0247bc7481d4304Christian Maeder addDiags[Diag Error "missing generated sort" ps]
c208973c890b8f993297720fd0247bc7481d4304Christian Maeder else return ()
c208973c890b8f993297720fd0247bc7481d4304Christian Maeder addSentences [NamedSen
0d0278c34a374b29c2d6c58b39b8b56e283d48e8Christian Maeder ("ga_generated_" ++
0d0278c34a374b29c2d6c58b39b8b56e283d48e8Christian Maeder showSepList (showString "_") showId sortList "")
0d0278c34a374b29c2d6c58b39b8b56e283d48e8Christian Maeder True False f]
0d0278c34a374b29c2d6c58b39b8b56e283d48e8Christian Maederana_SIG_ITEMS :: Pretty f => Min f e -> Ana s b s f e -> Mix b s f e
1842453990fed8a1bd7a5ac792d7982c1d2bfcd5Christian Maeder -> GenKind -> SIG_ITEMS s f -> State (Sign f e) (SIG_ITEMS s f)
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maederana_SIG_ITEMS mef anas mix gk si =
986d3f255182539098a97ac86da9eeee5b7a72e3Christian Maeder Sort_items al ps ->
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder do ul <- mapM (ana_SORT_ITEM mef mix) al
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder closeSubsortRel
01e278bdd7dce13b9303ed3d79683d83c89d09f9Liam O'Reilly return $ Sort_items ul ps
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder Op_items al ps ->
5ad5dffe06818a13e1632b1119fbca7881085fc1Dominik Luecke do ul <- mapM (ana_OP_ITEM mef mix) al
8c812cd83569e973f10cf69a342424ceabc07af9Christian Maeder return $ Op_items ul ps
8c812cd83569e973f10cf69a342424ceabc07af9Christian Maeder Pred_items al ps ->
8c812cd83569e973f10cf69a342424ceabc07af9Christian Maeder do ul <- mapM (ana_PRED_ITEM mef mix) al
1535e1d8c82db5f7e2402261983c4c2ef39f4f39Mihai Codescu return $ Pred_items ul ps
31d6d9286988dc31639d105841296759aeb743e0Jonathan von Schroeder Datatype_items al _ ->
1535e1d8c82db5f7e2402261983c4c2ef39f4f39Mihai Codescu do mapM_ (\ i -> case item i of
7a3fe82695aa32657693e05712f84d7f81672f2eJonathan von Schroeder Datatype_decl s _ _ -> addSort i s) al
7a3fe82695aa32657693e05712f84d7f81672f2eJonathan von Schroeder mapAnM (ana_DATATYPE_DECL gk) al
7a3fe82695aa32657693e05712f84d7f81672f2eJonathan von Schroeder closeSubsortRel
05a206508bc898f87fe6ab6e069814df3c29d303Dominik Luecke Ext_SIG_ITEMS s -> fmap Ext_SIG_ITEMS $ anas mix s
d54cd08a4cfa26256c38d8ed12c343adbfe1a0e3Christian Maederana_Generated :: Pretty f => Min f e -> Ana s b s f e -> Mix b s f e
d54cd08a4cfa26256c38d8ed12c343adbfe1a0e3Christian Maeder -> [Annoted (SIG_ITEMS s f)]
d54cd08a4cfa26256c38d8ed12c343adbfe1a0e3Christian Maeder -> State (Sign f e) ([GenAx], [Annoted (SIG_ITEMS s f)])
3b06e23643a9f65390cb8c1caabe83fa7e87a708Till Mossakowskiana_Generated mef anas mix al = do
b1f59a4ea7c96f4c03a4d7cfcb9c5e66871cfbbbChristian Maeder ul <- mapAnM (ana_SIG_ITEMS mef anas mix Generated) al
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder return (map (getGenSig . item) ul, ul)
0b349288edfa50fdf38fda1a14e1562d03f92574Christian MaedergetGenSig :: SIG_ITEMS s f -> GenAx
5afff1a0f62394414c33b06141175b3ab0b117a5Christian MaedergetGenSig si = case si of
5afff1a0f62394414c33b06141175b3ab0b117a5Christian Maeder Sort_items al _ -> unionGenAx $ map (getGenSorts . item) al
1b3a2f98d1cd01fc9e0591f69507e20526727559Dominik Luecke Set.unions (map (getOps . item) al))
f04e8f3ff56405901be968fd4c6e9769239f1a9bKlaus Luettich Datatype_items dl _ -> getDataGenSig dl
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder _ -> emptyGenAx
ea3bff3e547a1ac714d4db39c5efef95e02b2e7dChristian MaederisConsAlt :: ALTERNATIVE -> Bool
dd6f22b9dcff2695181b86372e4df03d5b96e92dKristina SojakovaisConsAlt a = case a of
005e0f0c6b0cc898003b03801158c208f3071fc5Kristina Sojakova Subsorts _ _ -> False
23b4e542dca35852f58d1fb3f7d9078c1de5ab06Christian MaedergetDataGenSig :: [Annoted DATATYPE_DECL] -> GenAx
23b4e542dca35852f58d1fb3f7d9078c1de5ab06Christian MaedergetDataGenSig dl =
76b9b2974795a6fb31f242fd032de3ff66df6204Christian Maeder let alts = concatMap (( \ (Datatype_decl s al _) ->
76b9b2974795a6fb31f242fd032de3ff66df6204Christian Maeder map ( \ a -> (s, item a)) al) . item) dl
8a78868bae2ec6838c87366c35c57e109154c51eChristian Maeder sorts = map fst alts
878a5ecd6acf973907e25e5be6e4a792ea19a05eEwaryst Schulz (realAlts, subs) = partition (isConsAlt . snd) alts
878a5ecd6acf973907e25e5be6e4a792ea19a05eEwaryst Schulz cs = map ( \ (s, a) ->
c2e192ace9ef7cfb0e59563f1b24477b2b65cff3Dominik Dietrich let (i, ty, _) = getConsType s a
6b75c206b317eb30a08d88a8f27e0295ffeb1546Christian Maeder in Component i ty) realAlts
9a4b469ca0a7f44a598e551a973c75195207db58Eugen Kuksa rel = foldr ( \ (t, a) r ->
48aa0645e25883048369afc02aac3f49b14a50daChristian Maeder foldr ( \ s ->
01645eac73dbc789392674930adc5745c935f3a0Christian Maeder r $ getAltSubsorts a)
bff4b3f816be4c1e1d8ded76f1d5af786839e1a9Christian Maeder in (Set.fromList sorts, rel, Set.fromList cs)
b5da047a9a875dec3f968b6c0df96af326f90fa9Alexis TsogiasgetGenSorts :: SORT_ITEM f -> GenAx
0a03acf9fa28e6ff00f4d7c9c6acbae64cf09c56Ewaryst SchulzgetGenSorts si =
0a03acf9fa28e6ff00f4d7c9c6acbae64cf09c56Ewaryst Schulz let (sorts, rel) = case si of
a604cbad8e2202147b5c6bb9f2e06ae61162d654Felix Gabriel Mance Sort_decl il _ -> (Set.fromList il, Rel.empty)
308834907a120fd8771e18292ed2ca9cd767c12dChristian Maeder Subsort_decl il i _ -> (Set.fromList (i:il)
bab2d88d650448628730ed3b65c9f99c52500e8cChristian Maeder Subsort_defn sub _ super _ _ -> (Set.singleton sub
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Iso_decl il _ -> (Set.fromList il
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder , foldr ( \ s r -> foldr ( \ t ->
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder in (sorts, rel, Set.empty)
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaedergetOps :: OP_ITEM f -> Set.Set Component
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaedergetOps oi = case oi of
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Op_decl is ty _ _ ->
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Set.fromList $ map ( \ i -> Component i $ toOpType ty) is
7a3fe82695aa32657693e05712f84d7f81672f2eJonathan von Schroeder Op_defn i par _ _ ->
7a3fe82695aa32657693e05712f84d7f81672f2eJonathan von Schroeder Set.singleton $ Component i $ toOpType $ headToType par
1535e1d8c82db5f7e2402261983c4c2ef39f4f39Mihai Codescuana_SORT_ITEM :: Pretty f => Min f e -> Mix b s f e
1535e1d8c82db5f7e2402261983c4c2ef39f4f39Mihai Codescu -> Annoted (SORT_ITEM f)
1535e1d8c82db5f7e2402261983c4c2ef39f4f39Mihai Codescu -> State (Sign f e) (Annoted (SORT_ITEM f))
1535e1d8c82db5f7e2402261983c4c2ef39f4f39Mihai Codescuana_SORT_ITEM mef mix asi =
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder case item asi of
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Sort_decl il _ ->
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder do mapM_ (addSort asi) il
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Subsort_decl il i _ ->
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder do mapM_ (addSort asi) (i:il)
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder mapM_ (addSubsort i) il
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Subsort_defn sub v super af ps ->
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder do e <- get -- save
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder put e { varMap = Map.empty }
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder addVars (Var_decl [v] super ps)
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder put e -- restore
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder let Result ds mf = anaForm mef mix sign $ item af
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder lb = getRLabel af
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder lab = if null lb then getRLabel asi else lb
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder addSort asi sub
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder addSubsort super sub
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Nothing -> return asi { item = Subsort_decl [sub] super ps}
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Just (resF, anaF) -> do
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder let p = posOfId sub
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder pv = tokPos v
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder addSentences[NamedSen lab (notImplied af) True $
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder mkForall [Var_decl [v] super pv]
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder (Membership (Qual_var v super pv) sub p)
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder return asi { item = Subsort_defn sub v super
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder af { item = resF } ps}
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Iso_decl il _ ->
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder do mapM_ (addSort asi) il
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder [] -> return ()
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder _ : tl -> mapM_ (uncurry $ addSubsortOrIso False)
48aa0645e25883048369afc02aac3f49b14a50daChristian Maederana_OP_ITEM :: Pretty f => Min f e -> Mix b s f e -> Annoted (OP_ITEM f)
9f85afecbd79b3df5a0bb17bd28cd0b288dc3213Kristina Sojakova -> State (Sign f e) (Annoted (OP_ITEM f))
79834070d6d3c63a098e570b12fa3405c607dc70Kristina Sojakovaana_OP_ITEM mef mix aoi =
79834070d6d3c63a098e570b12fa3405c607dc70Kristina Sojakova case item aoi of
79834070d6d3c63a098e570b12fa3405c607dc70Kristina Sojakova Op_decl ops ty il ps ->
23b4e542dca35852f58d1fb3f7d9078c1de5ab06Christian Maeder do let oty = toOpType ty
23b4e542dca35852f58d1fb3f7d9078c1de5ab06Christian Maeder ni = notImplied aoi
23b4e542dca35852f58d1fb3f7d9078c1de5ab06Christian Maeder mapM_ (addOp aoi oty) ops
8a78868bae2ec6838c87366c35c57e109154c51eChristian Maeder ul <- mapM (ana_OP_ATTR mef mix oty ni ops) il
8a78868bae2ec6838c87366c35c57e109154c51eChristian Maeder if null $ filter ( \ i -> case i of
8a78868bae2ec6838c87366c35c57e109154c51eChristian Maeder Assoc_op_attr -> True
624e6701e0deb7ac6c03c0cba0190fbc5033cf93Ewaryst Schulz _ -> False) il
624e6701e0deb7ac6c03c0cba0190fbc5033cf93Ewaryst Schulz then return ()
c2e192ace9ef7cfb0e59563f1b24477b2b65cff3Dominik Dietrich else mapM_ (addAssocOp oty) ops
7165a916d2fa1bf87c4741ec63b253413eebbf69Karl Luc return aoi {item = Op_decl ops ty (catMaybes ul) ps}
7165a916d2fa1bf87c4741ec63b253413eebbf69Karl Luc Op_defn i ohd at ps ->
7165a916d2fa1bf87c4741ec63b253413eebbf69Karl Luc do let ty = headToType ohd
01645eac73dbc789392674930adc5745c935f3a0Christian Maeder lb = getRLabel at
01645eac73dbc789392674930adc5745c935f3a0Christian Maeder lab = if null lb then getRLabel aoi else lb
01645eac73dbc789392674930adc5745c935f3a0Christian Maeder args = case ohd of
bff4b3f816be4c1e1d8ded76f1d5af786839e1a9Christian Maeder Op_head _ as _ _ -> as
bff4b3f816be4c1e1d8ded76f1d5af786839e1a9Christian Maeder vs = map (\ (Arg_decl v s qs) -> (Var_decl v s qs)) args
bff4b3f816be4c1e1d8ded76f1d5af786839e1a9Christian Maeder arg = concatMap ( \ (Var_decl v s qs) ->
b5da047a9a875dec3f968b6c0df96af326f90fa9Alexis Tsogias map ( \ j -> Qual_var j s qs) v) vs
fc09e0a6af734edbd944dd8082bb51985c233b43Alexis Tsogias addOp aoi (toOpType ty) i
b5da047a9a875dec3f968b6c0df96af326f90fa9Alexis Tsogias e <- get -- save
0a03acf9fa28e6ff00f4d7c9c6acbae64cf09c56Ewaryst Schulz put e { varMap = Map.empty }
0a03acf9fa28e6ff00f4d7c9c6acbae64cf09c56Ewaryst Schulz mapM_ addVars vs
bab2d88d650448628730ed3b65c9f99c52500e8cChristian Maeder put e -- restore
18d370f8341357f5d6a4068f4bb6981173ece70fFelix Gabriel Mance let Result ds mt = anaTerm mef mix sign
0a03acf9fa28e6ff00f4d7c9c6acbae64cf09c56Ewaryst Schulz (res_OP_TYPE ty) ps $ item at
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder Nothing -> return aoi { item = Op_decl [i] ty [] ps }
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder Just (resT, anaT) -> do
8b0f493ae42bad8b94918cc0957f1af57096cda4Felix Reckers let p = posOfId i
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder addSentences [NamedSen lab (notImplied at) True $ mkForall vs
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder (Strong_equation
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder (Application (Qual_op_name i ty p) arg ps)
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder return aoi {item = Op_defn i ohd at { item = resT } ps }
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaederheadToType :: OP_HEAD -> OP_TYPE
43b4c41fbb07705c9df321221ab9cb9832460407Christian MaederheadToType (Op_head k args r ps) = Op_type k (sortsOfArgs args) r ps
61fa0ac06ede811c7aad54ec4c4202346727368eChristian MaedersortsOfArgs :: [ARG_DECL] -> [SORT]
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian MaedersortsOfArgs = concatMap ( \ (Arg_decl l s _) -> map (const s) l)
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maederana_OP_ATTR :: Pretty f => Min f e -> Mix b s f e -> OpType -> Bool -> [Id]
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich -> (OP_ATTR f) -> State (Sign f e) (Maybe (OP_ATTR f))
1aee4aaddde105264c1faf394d88e302c05094ffChristian Maederana_OP_ATTR mef mix ty ni ois oa = do
10883d13973c46cac98964b66ace7a52b2d059abChristian Maeder let sty = toOP_TYPE ty
f443a57f2a8e0ca3daa7431b0c89a18ba52c337aChristian Maeder rty = opRes ty
e284004f10a315dbdb624c8b2522f65d485eaa48Martin Kühl atys = opArgs ty
857992065be4ed40a72c6296b6c0aec62ab4c5b9Christian Maeder q = posOfId rty
7c99e334446bb97120e30e967baeeddfdd1278deKlaus Luettich [t1,t2] | t1 == t2 -> case oa of
dcbd32289a7bdf1e6edd06c6ab0698c6a9dbf37aChristian Maeder Comm_op_attr -> return ()
dcbd32289a7bdf1e6edd06c6ab0698c6a9dbf37aChristian Maeder _ -> if t1 == rty then return ()
dcbd32289a7bdf1e6edd06c6ab0698c6a9dbf37aChristian Maeder else addDiags [Diag Error
fc436618ae33856afa329ee53c4f47a2e19100eeChristian Maeder "result sort must be equal to argument sorts" q]
27785f379d6810811b4e6d23feab18845fde9a98Christian Maeder _ -> addDiags [Diag Error
2d130d212db7208777ca896a7ecad619a8944971Christian Maeder "expecting two arguments of equal sort" q]
e7757995211bd395dc79d26fe017d99375f7d2a6Christian Maeder Unit_op_attr t ->
ac0bbbcb2774629bb87986e69cf53d3402c5f575Christian Maeder do sign <- get
33d042fe6a9eb27a4c48f840b80838f3e7d98e34Christian Maeder let Result ds mt = anaTerm mef mix
83394c6b6e6de128e71b67c9251ed7a84485d082Christian Maeder sign { varMap = Map.empty } rty q t
e7757995211bd395dc79d26fe017d99375f7d2a6Christian Maeder Nothing -> return Nothing
0c355dd0b739631ee472f9a656e266be27fa4e64Christian Maeder Just (resT, anaT) -> do
fa21fba9ceb1ddf7b3efd54731a12ed8750191d8Christian Maeder addSentences $ map (makeUnit True anaT ty ni) ois
e7757995211bd395dc79d26fe017d99375f7d2a6Christian Maeder addSentences $ map (makeUnit False anaT ty ni) ois
c7ec85d1103173e089aa5048fd7afb2f9b505124Klaus Luettich return $ Just $ Unit_op_attr resT
c7ec85d1103173e089aa5048fd7afb2f9b505124Klaus Luettich Assoc_op_attr -> do
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder let ns = map mkSimpleId ["x", "y", "z"]
c7ec85d1103173e089aa5048fd7afb2f9b505124Klaus Luettich vs = map ( \ v -> Var_decl [v] rty q) ns
c7ec85d1103173e089aa5048fd7afb2f9b505124Klaus Luettich [v1, v2, v3] = map ( \ v -> Qual_var v rty q) ns
810746aea00b81c1eec27dae84d73a43599ff056Christian Maeder makeAssoc i = let p = posOfId i
a883cd4d01fe39d23219cf5333425f195be24d8bChristian Maeder qi = Qual_op_name i sty p in
b905126bab9454b89041f92b3c50bb9efc85e427Klaus Luettich NamedSen ("ga_assoc_" ++ showId i "") ni False $
33d042fe6a9eb27a4c48f840b80838f3e7d98e34Christian Maeder (Strong_equation
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder (Application qi [v1, Application qi [v2, v3] p] p)
0a5571c8adeddd27548445546491725beb224dddChristian Maeder (Application qi [Application qi [v1, v2] p, v3] p) p) p
0a5571c8adeddd27548445546491725beb224dddChristian Maeder addSentences $ map makeAssoc ois
0a5571c8adeddd27548445546491725beb224dddChristian Maeder return $ Just oa
0a5571c8adeddd27548445546491725beb224dddChristian Maeder Comm_op_attr -> do
0a5571c8adeddd27548445546491725beb224dddChristian Maeder let ns = map mkSimpleId ["x", "y"]
f38b3687c5558128515e34fb85d8b466d22dc300Christian Maeder vs = zipWith ( \ v t -> Var_decl [v] t
e112e83352048f3db8c8f93ae104193e7338c10fChristian Maeder $ concatMapRange posOfId atys) ns atys
f38b3687c5558128515e34fb85d8b466d22dc300Christian Maeder args = map toQualVar vs
f38b3687c5558128515e34fb85d8b466d22dc300Christian Maeder makeComm i = let p = posOfId i
0a5571c8adeddd27548445546491725beb224dddChristian Maeder qi = Qual_op_name i sty p in
f38b3687c5558128515e34fb85d8b466d22dc300Christian Maeder NamedSen ("ga_comm_" ++ showId i "") ni False $
74d27713392cbbe39ecd72d0ddb0caad16e84555Christian Maeder (Strong_equation
ef67402074be14deb95e4ff564737d5593144130Klaus Luettich (Application qi args p)
e112e83352048f3db8c8f93ae104193e7338c10fChristian Maeder (Application qi (reverse args) p) p) p
ac0bbbcb2774629bb87986e69cf53d3402c5f575Christian Maeder addSentences $ map makeComm ois
aebb0b18fe5e6ba7dd7e4c66a16a905611ef7ba9Christian Maeder return $ Just oa
e05fd774e0181e93963d4302303b20698603a505Christian Maeder Idem_op_attr -> do
ac0bbbcb2774629bb87986e69cf53d3402c5f575Christian Maeder let v = mkSimpleId "x"
aebb0b18fe5e6ba7dd7e4c66a16a905611ef7ba9Christian Maeder vd = Var_decl [v] rty q
ac0bbbcb2774629bb87986e69cf53d3402c5f575Christian Maeder qv = toQualVar vd
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder makeIdem i = let p = posOfId i in
e05fd774e0181e93963d4302303b20698603a505Christian Maeder NamedSen ("ga_idem_" ++ showId i "") ni False $
ac0bbbcb2774629bb87986e69cf53d3402c5f575Christian Maeder mkForall [vd]
f2d9352f2999f82c36b4b65535d14a6a40ae5a82Christian Maeder (Strong_equation
340706b6c0c6e3dbacdd7003e20e9cab7f9aa765Christian Maeder (Application (Qual_op_name i sty p) [qv, qv] p)
483333cb1e873b6d55f5ef0bfbf061861f0493abChristian Maeder addSentences $ map makeIdem ois
fdb2d618144159395f7bf8ce3327b3c112a17dd3Till Mossakowski return $ Just oa
1dfba1f850f6a43094962b459998d1ea11472461Christian Maeder-- first bool for left and right, second one for no implied annotation
1dfba1f850f6a43094962b459998d1ea11472461Christian MaedermakeUnit :: Bool -> TERM f -> OpType -> Bool -> Id -> Named (FORMULA f)
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaedermakeUnit b t ty ni i =
fa0f3519d71f719d88577b716b1579776b4a2535Christian Maeder let lab = "ga_" ++ (if b then "right" else "left") ++ "_unit_"
e7757995211bd395dc79d26fe017d99375f7d2a6Christian Maeder ++ showId i ""
99afa6000472f3d291fdf9193ea19d334a58658dChristian Maeder v = mkSimpleId "x"
fa0f3519d71f719d88577b716b1579776b4a2535Christian Maeder vty = opRes ty
99afa6000472f3d291fdf9193ea19d334a58658dChristian Maeder q = posOfId vty
5bb7eeaca10ea76595229375f907a5a388b7c882Christian Maeder p = posOfId i
5bb7eeaca10ea76595229375f907a5a388b7c882Christian Maeder qv = Qual_var v vty q
5bb7eeaca10ea76595229375f907a5a388b7c882Christian Maeder args = [qv, t]
c59d1c38ef94b4fb1c8d9fda9573bc1e1d2801e7Christian Maeder rargs = if b then args else reverse args
cd36bffee51c77cdadcb9f916b34fa512e311946Christian Maeder in NamedSen lab ni False $ mkForall [Var_decl [v] vty q]
99afa6000472f3d291fdf9193ea19d334a58658dChristian Maeder (Strong_equation
ac0bbbcb2774629bb87986e69cf53d3402c5f575Christian Maeder (Application (Qual_op_name i (toOP_TYPE ty) p) rargs p)
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettichana_PRED_ITEM :: Pretty f => Min f e -> Mix b s f e
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich -> Annoted (PRED_ITEM f)
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich -> State (Sign f e) (Annoted (PRED_ITEM f))
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettichana_PRED_ITEM mef mix ap =
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich case item ap of
36f63902db2b3463faa9f59912ad106e2d5aaa24Klaus Luettich Pred_decl preds ty _ ->
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich do mapM (addPred ap $ toPredType ty) preds
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich Pred_defn i phd@(Pred_head args rs) at ps ->
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich do let lb = getRLabel at
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich lab = if null lb then getRLabel ap else lb
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder ty = Pred_type (sortsOfArgs args) rs
e7757995211bd395dc79d26fe017d99375f7d2a6Christian Maeder vs = map (\ (Arg_decl v s qs) -> (Var_decl v s qs)) args
810746aea00b81c1eec27dae84d73a43599ff056Christian Maeder arg = concatMap ( \ (Var_decl v s qs) ->
6dc9bc98d0854fe2e3dd3bfc4275096a0c28ee1cChristian Maeder map ( \ j -> Qual_var j s qs) v) vs
8b0f493ae42bad8b94918cc0957f1af57096cda4Felix Reckers addPred ap (toPredType ty) i
1365c420ef71be3d52796ebd369dc2defdedc822Christian Maeder e <- get -- save
a80c28bb8b7a23ccdf7e08d0fe216fc19cc97273Klaus Luettich put e { varMap = Map.empty }
82e29b77f0ef4cccd7ed734692c5e1e93dbbc645Christian Maeder mapM_ addVars vs
5f0e3e4cb7dd31033c9682cafa712d2a66b2f3bcChristian Maeder put e -- restore
5f0e3e4cb7dd31033c9682cafa712d2a66b2f3bcChristian Maeder let Result ds mt = anaForm mef mix sign $ item at
e7757995211bd395dc79d26fe017d99375f7d2a6Christian Maeder Nothing -> return ap {item = Pred_decl [i] ty ps}
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder Just (resF, anaF) -> do
d0652648f9879c67a194f8b03baafe2700c68eb4Christian Maeder let p = posOfId i
210aa1071465039588fa9e38c10e343631c34655Christian Maeder addSentences [NamedSen lab True True $
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder (Equivalence (Predication (Qual_pred_name i ty p)
b1f59a4ea7c96f4c03a4d7cfcb9c5e66871cfbbbChristian Maeder arg p) anaF p) p]
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich return ap {item = Pred_defn i phd at { item = resF } ps}
4ba08bfca0cc8d9da65397b8dfd2654fdb4c0e62Christian Maeder-- full function type of a selector (result sort is component sort)
4ba08bfca0cc8d9da65397b8dfd2654fdb4c0e62Christian Maederdata Component = Component { compId :: Id, compType :: OpType }
4ba08bfca0cc8d9da65397b8dfd2654fdb4c0e62Christian Maeder deriving (Show)
4ba08bfca0cc8d9da65397b8dfd2654fdb4c0e62Christian Maederinstance Eq Component where
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich Component i1 t1 == Component i2 t2 =
1365c420ef71be3d52796ebd369dc2defdedc822Christian Maeder (i1, opArgs t1, opRes t1) == (i2, opArgs t2, opRes t2)
308834907a120fd8771e18292ed2ca9cd767c12dChristian Maederinstance Ord Component where
1365c420ef71be3d52796ebd369dc2defdedc822Christian Maeder Component i1 t1 <= Component i2 t2 =
83394c6b6e6de128e71b67c9251ed7a84485d082Christian Maeder (i1, opArgs t1, opRes t1) <= (i2, opArgs t2, opRes t2)
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maederinstance Pretty Component where
1aee4aaddde105264c1faf394d88e302c05094ffChristian Maeder pretty (Component i ty) =
1aee4aaddde105264c1faf394d88e302c05094ffChristian Maeder pretty i <+> colon <> pretty ty
10883d13973c46cac98964b66ace7a52b2d059abChristian Maederinstance PosItem Component where
1aee4aaddde105264c1faf394d88e302c05094ffChristian Maeder getRange = getRange . compId
68d10d143f29fcff3c637ba24f90e983995ceae6Christian Maeder-- | return list of constructors
e7757995211bd395dc79d26fe017d99375f7d2a6Christian Maederana_DATATYPE_DECL :: GenKind -> DATATYPE_DECL -> State (Sign f e) [Component]
c5e3fc166373b0d90f6e36e8aa234396a1dcd879Christian Maederana_DATATYPE_DECL gk (Datatype_decl s al _) =
340706b6c0c6e3dbacdd7003e20e9cab7f9aa765Christian Maeder do ul <- mapM (ana_ALTERNATIVE s) al
3e61f574717499939bd8e0ff538ea9e7b72d4e2dKlaus Luettich let constr = catMaybes ul
4ba08bfca0cc8d9da65397b8dfd2654fdb4c0e62Christian Maeder cs = map fst constr
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder if null constr then return ()
68d10d143f29fcff3c637ba24f90e983995ceae6Christian Maeder else do addDiags $ checkUniqueness cs
e1559d046eb2c6dde0e6e272b37b6756eac0e8adChristian Maeder let totalSels = Set.unions $ map snd constr
68d10d143f29fcff3c637ba24f90e983995ceae6Christian Maeder wrongConstr = filter ((totalSels /=) . snd) constr
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder addDiags $ map ( \ (c, _) -> mkDiag Error
2c619a4dfdc1df27573eba98e81ed1ace906941dChristian Maeder ("total selectors '" ++ showSepList (showString ",")
5580ab3e64410186ccd36cde8a94282d8757ac0dChristian Maeder showDoc (Set.toList totalSels)
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder "'\n must appear in alternative") c) wrongConstr
e284004f10a315dbdb624c8b2522f65d485eaa48Martin Kühl let allts = map item al
e284004f10a315dbdb624c8b2522f65d485eaa48Martin Kühl (alts, subs) = partition isConsAlt allts
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder sbs = concatMap getAltSubsorts subs
50515239e7e190f4a34ca581dd685d002148fbddChristian Maeder comps = map (getConsType s) alts
50515239e7e190f4a34ca581dd685d002148fbddChristian Maeder ttrips = map (( \ (a, vs, t, ses) -> (a, vs, t, catSels ses))
0b349288edfa50fdf38fda1a14e1562d03f92574Christian Maeder . selForms1 "X" ) comps
0b349288edfa50fdf38fda1a14e1562d03f92574Christian Maeder sels = concatMap ( \ (_, _, _, ses) -> ses) ttrips
0b349288edfa50fdf38fda1a14e1562d03f92574Christian Maeder addSentences $ map makeInjective
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder $ filter ( \ (_, _, ces) -> not $ null ces)
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder addSentences $ makeDisjSubsorts s sbs
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder addSentences $ concatMap ( \ c -> map (makeDisjToSort c) sbs)
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder addSentences $ makeDisjoint comps
8b4c68db8b465107cabef8b9cd5b6bc216e1b156Till Mossakowski addSentences $ catMaybes $ concatMap
8b4c68db8b465107cabef8b9cd5b6bc216e1b156Till Mossakowski map (makeUndefForm ses) ttrips) sels
bcaf979d9babe6346aa343687aa7d596e2894cccPaolo Torrini _ -> return ()
5ce19352a9cc47d982819cc889a71cd0a61ac171Christian MaedermakeDisjSubsorts :: SORT -> [SORT] -> [Named (FORMULA f)]
5ce19352a9cc47d982819cc889a71cd0a61ac171Christian MaedermakeDisjSubsorts d subs = case subs of
bcaf979d9babe6346aa343687aa7d596e2894cccPaolo Torrini s : rs -> map (makeDisjSubsort s) rs ++ makeDisjSubsorts d rs
df29370ae8d8b41587957f6bcdcb43a3f1927e47Christian Maeder makeDisjSubsort :: SORT -> SORT -> Named (FORMULA f)
23ab8855c58adfbd03a0730584b917b24c603901Christian Maeder makeDisjSubsort s1 s2 = let
e50e41135ece589f7202bd4ef8d6b97531c2a56eKlaus Luettich n = mkSimpleId "x"
47b0e9f3cb008cb7997f4e3bae26e4d62dcc887aChristian Maeder pd = posOfId d
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder p1 = posOfId s1
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder p2 = posOfId s2
431d34c7007a787331c4e5ec997badb0f8190fc7Christian Maeder p = pd `appRange` p1 `appRange` p2
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder v = Var_decl [n] d pd
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder qv = toQualVar v
99afa6000472f3d291fdf9193ea19d334a58658dChristian Maeder in NamedSen ("ga_disjoint_sorts_" ++ showId s1 "_"
43b4c41fbb07705c9df321221ab9cb9832460407Christian Maeder ++ showId s2 "") True False $
88318aafc287e92931dceffbb943d58a9310001dChristian Maeder mkForall [v] (Negation (Conjunction [
d5d349836d8b1fa93ea49a59d977b106c6e9233bKlaus Luettich Membership qv s1 p1, Membership qv s2 p2] p) p) p
88318aafc287e92931dceffbb943d58a9310001dChristian MaedermakeDisjToSort :: (Id, OpType, [COMPONENTS]) -> SORT -> Named (FORMULA f)
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian MaedermakeDisjToSort a s =
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder let (c, v, t, _) = selForms1 "X" a
43b4c41fbb07705c9df321221ab9cb9832460407Christian Maeder p = posOfId s in
43b4c41fbb07705c9df321221ab9cb9832460407Christian Maeder NamedSen ("ga_disjoint_" ++ showId c "_sort_"
e62d49c0dc2893da75faad896bd135e2e9a7087bKlaus Luettich ++ showId s "") True False $
9096f6c6aaded6cd8288656ceccd4c7b3bd0747eChristian Maeder mkForall v (Negation (Membership t s p) p) p
e112e83352048f3db8c8f93ae104193e7338c10fChristian MaedermakeInjective :: (Id, OpType, [COMPONENTS]) -> Named (FORMULA f)
e112e83352048f3db8c8f93ae104193e7338c10fChristian MaedermakeInjective a =
e62d49c0dc2893da75faad896bd135e2e9a7087bKlaus Luettich let (c, v1, t1, _) = selForms1 "X" a
e62d49c0dc2893da75faad896bd135e2e9a7087bKlaus Luettich (_, v2, t2, _) = selForms1 "Y" a
e62d49c0dc2893da75faad896bd135e2e9a7087bKlaus Luettich p = posOfId c
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder in NamedSen ("ga_injective_" ++ showId c "") True False $
e112e83352048f3db8c8f93ae104193e7338c10fChristian Maeder mkForall (v1 ++ v2)
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder (Equivalence (Strong_equation t1 t2 p)
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder (let ces = zipWith ( \ w1 w2 -> Strong_equation
61fa0ac06ede811c7aad54ec4c4202346727368eChristian Maeder (toQualVar w1) (toQualVar w2) p) v1 v2
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder in if isSingle ces then head ces else Conjunction ces p)
363939beade943a02b31004cea09dec34fa8a6d9Christian MaedermakeDisjoint :: [(Id, OpType, [COMPONENTS])] -> [Named (FORMULA f)]
c72c1e75a969ff4c336e77481c2a8e42603f13eeChristian MaedermakeDisjoint l = case l of
fdef3358918491badb0e29e42b5d3b5a01950716Christian Maeder c : cs -> map (makeDisj c) cs ++ makeDisjoint cs
6ff7a91875597d6e4dfaa68c79187d01473e8341Christian Maeder makeDisj :: (Id, OpType, [COMPONENTS]) -> (Id, OpType, [COMPONENTS])
6ff7a91875597d6e4dfaa68c79187d01473e8341Christian Maeder -> Named (FORMULA f)
88318aafc287e92931dceffbb943d58a9310001dChristian Maeder makeDisj a1 a2 =
fdef3358918491badb0e29e42b5d3b5a01950716Christian Maeder let (c1, v1, t1, _) = selForms1 "X" a1
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder (c2, v2, t2, _) = selForms1 "Y" a2
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder p = posOfId c1 `appRange` posOfId c2
88318aafc287e92931dceffbb943d58a9310001dChristian Maeder in NamedSen ("ga_disjoint_" ++ showId c1 "_" ++ showId c2 "") True False
7767474aba4fa2dc51a6c68017d3bcef3b773001Christian Maeder $ mkForall (v1 ++ v2)
88318aafc287e92931dceffbb943d58a9310001dChristian Maeder (Negation (Strong_equation t1 t2 p) p) p
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaedercatSels :: [(Maybe Id, OpType)] -> [(Id, OpType)]
340706b6c0c6e3dbacdd7003e20e9cab7f9aa765Christian MaedercatSels = map ( \ (m, t) -> (fromJust m, t)) .
88318aafc287e92931dceffbb943d58a9310001dChristian Maeder filter ( \ (m, _) -> isJust m)
88318aafc287e92931dceffbb943d58a9310001dChristian MaedermakeUndefForm :: (Id, OpType) -> (Id, [VAR_DECL], TERM f, [(Id, OpType)])
fdb2d618144159395f7bf8ce3327b3c112a17dd3Till Mossakowski -> Maybe (Named (FORMULA f))
e7757995211bd395dc79d26fe017d99375f7d2a6Christian MaedermakeUndefForm (s, ty) (i, vs, t, sels) =
6e049108aa87dc46bcff96fae50a4625df1d9648Klaus Luettich let p = posOfId s in
473bc1f3f3443f18e0ee83e4642fab42183470f2Christian Maeder if any ( \ (se, ts) -> s == se && opRes ts == opRes ty ) sels
473bc1f3f3443f18e0ee83e4642fab42183470f2Christian Maeder then Nothing else
6e049108aa87dc46bcff96fae50a4625df1d9648Klaus Luettich Just $ NamedSen ("ga_selector_undef_" ++ showId s "_"
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder ++ showId i "") True False $
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder (Application (Qual_op_name s (toOP_TYPE ty) p) [t] p)
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian MaedergetAltSubsorts :: ALTERNATIVE -> [SORT]
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian MaedergetAltSubsorts c = case c of
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder Subsorts cs _ -> cs
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian MaedergetConsType :: SORT -> ALTERNATIVE -> (Id, OpType, [COMPONENTS])
1a6464613c59e35072b90ca296ae402cbe956144Christian MaedergetConsType s c =
8b767d09a78927b111f5596fdff9ca7d2c1a439fChristian Maeder let getConsTypeAux (part, i, il) =
8b767d09a78927b111f5596fdff9ca7d2c1a439fChristian Maeder (i, OpType part (concatMap
8b767d09a78927b111f5596fdff9ca7d2c1a439fChristian Maeder (map (opRes . snd) . getCompType s) il) s, il)
8b767d09a78927b111f5596fdff9ca7d2c1a439fChristian Maeder Subsorts _ _ -> error "getConsType"
8b767d09a78927b111f5596fdff9ca7d2c1a439fChristian Maeder Alt_construct k a l _ -> getConsTypeAux (k, a, l)
456238178f89e5a3de2988ee6c8af924297d52d9Christian MaedergetCompType :: SORT -> COMPONENTS -> [(Maybe Id, OpType)]
f78ce817f35574674d54e30ad1861a9b4ced20caChristian MaedergetCompType s (Cons_select k l cs _) =
f78ce817f35574674d54e30ad1861a9b4ced20caChristian Maeder map (\ i -> (Just i, OpType k [s] cs)) l
f78ce817f35574674d54e30ad1861a9b4ced20caChristian MaedergetCompType s (Sort cs) = [(Nothing, OpType Partial [s] cs)]
fd2c22348e5a69231f92fb44e35a9970b47c4e93Christian MaedergenSelVars :: String -> Int -> [OpType] -> [VAR_DECL]
f78ce817f35574674d54e30ad1861a9b4ced20caChristian MaedergenSelVars _ _ [] = []
f78ce817f35574674d54e30ad1861a9b4ced20caChristian MaedergenSelVars str n (ty:rs) =
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Var_decl [mkSelVar str n] (opRes ty) nullRange : genSelVars str (n+1) rs
f78ce817f35574674d54e30ad1861a9b4ced20caChristian MaedermkSelVar :: String -> Int -> Token
f78ce817f35574674d54e30ad1861a9b4ced20caChristian MaedermkSelVar str n = mkSimpleId (str ++ show n)
f041c9a6bda23de33a38490e35b831ae18d96b45Christian MaedermakeSelForms :: Int -> (Id, [VAR_DECL], TERM f, [(Maybe Id, OpType)])
f041c9a6bda23de33a38490e35b831ae18d96b45Christian Maeder -> [Named (FORMULA f)]
f041c9a6bda23de33a38490e35b831ae18d96b45Christian MaedermakeSelForms _ (_, _, _, []) = []
bea81dabd203833818cb4a5f3758977c695728cdHeng JiangmakeSelForms n (i, vs, t, (mi, ty):rs) =
456238178f89e5a3de2988ee6c8af924297d52d9Christian Maeder Nothing -> []
49d647f58ec5bf482da541eec62f531848c49036Christian Maeder Just j -> let p = posOfId j
f9442174f64331ccf0bf08178632af7302ccfc96Christian Maeder rty = opRes ty
f9442174f64331ccf0bf08178632af7302ccfc96Christian Maeder q = posOfId rty in
f9442174f64331ccf0bf08178632af7302ccfc96Christian Maeder [NamedSen ("ga_selector_" ++ showId j "") True False
f9442174f64331ccf0bf08178632af7302ccfc96Christian Maeder $ mkForall vs
c802a1041ed9251f8ad79139454267e802900e2aChristian Maeder (Strong_equation
53bbc1c9a4e986d1ee9c081d6f0ac7b9546f212bDominik Luecke (Application (Qual_op_name j (toOP_TYPE ty) p) [t] p)
bf7b17b0e19362e9228672782218678cab275d1eDominik Luecke (Qual_var (mkSelVar "X" n) rty q) p) p]
bf7b17b0e19362e9228672782218678cab275d1eDominik Luecke ) ++ makeSelForms (n+1) (i, vs, t, rs)
bf7b17b0e19362e9228672782218678cab275d1eDominik LueckeselForms1 :: String -> (Id, OpType, [COMPONENTS])
bf7b17b0e19362e9228672782218678cab275d1eDominik Luecke -> (Id, [VAR_DECL], TERM f, [(Maybe Id, OpType)])
bf7b17b0e19362e9228672782218678cab275d1eDominik LueckeselForms1 str (i, ty, il) =
bf7b17b0e19362e9228672782218678cab275d1eDominik Luecke let cs = concatMap (getCompType (opRes ty)) il
75b0c0c2cbfb7edd3f4c0555227aabbe6c1aa195Christian Maeder vs = genSelVars str 1 $ map snd cs
bf7b17b0e19362e9228672782218678cab275d1eDominik Luecke in (i, vs, Application (Qual_op_name i (toOP_TYPE ty) nullRange)
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiu (map toQualVar vs) nullRange, cs)
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae BungiutoQualVar :: VAR_DECL -> TERM f
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae BungiutoQualVar (Var_decl v s ps) =
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiu if isSingle v then Qual_var (head v) s ps else error "toQualVar"
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae BungiuselForms :: (Id, OpType, [COMPONENTS]) -> [Named (FORMULA f)]
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae BungiuselForms = makeSelForms 1 . selForms1 "X"
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiu-- | return the constructor and the set of total selectors
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiuana_ALTERNATIVE :: SORT -> Annoted ALTERNATIVE
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiu -> State (Sign f e) (Maybe (Component, Set.Set Component))
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiuana_ALTERNATIVE s c =
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiu Subsorts ss _ -> do
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiu mapM_ (addSubsort s) ss
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiu let cons@(i, ty, il) = getConsType s ic
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiu ul <- mapM (ana_COMPONENTS s) il
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiu let ts = concatMap fst ul
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiu addDiags $ checkUniqueness (ts ++ concatMap snd ul)
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiu addSentences $ selForms cons
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiu return $ Just (Component i ty, Set.fromList ts)
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiu-- | return total and partial selectors
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiuana_COMPONENTS :: SORT -> COMPONENTS
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiu -> State (Sign f e) ([Component], [Component])
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiuana_COMPONENTS s c = do
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiu let cs = getCompType s c
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiu sels <- mapM ( \ (mi, ty) ->
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiu Nothing -> return Nothing
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiu Just i -> do addOp (emptyAnno ()) ty i
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiu return $ Just $ Component i ty) cs
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiu return $ partition ((==Total) . opKind . compType) $ catMaybes sels
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae BungiuresultToState :: (a -> Result a) -> a -> State (Sign f e) a
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae BungiuresultToState f a = do
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiu addDiags $ diags r
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiu case maybeResult r of
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiu Nothing -> return a
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiu Just b -> return b
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiu-- wrap it all up for a logic
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiutype Ana a b s f e = Mix b s f e -> a -> State (Sign f e) a
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae BungiuanaForm :: Pretty f => Min f e -> Mix b s f e -> Sign f e -> FORMULA f
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiu -> Result (FORMULA f, FORMULA f)
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae BungiuanaForm mef mix sign f = do
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiu resF <- resolveFormula (putParen mix) (mixResolve mix)
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiu (globAnnos sign) (mixRules mix) f
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiu anaF <- minExpFORMULA mef sign
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiu $ assert (noMixfixF (checkMix mix) resF) resF
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiu return (resF, anaF)
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae BungiuanaTerm :: Pretty f => Min f e -> Mix b s f e -> Sign f e -> SORT -> Range
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiu -> TERM f -> Result (TERM f, TERM f)
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae BungiuanaTerm mef mix sign srt pos t = do
ae3e4689adbf4de67f4e1cdda6db2c0e406027d0Francisc Nicolae Bungiu resT <- resolveMixfix (putParen mix) (mixResolve mix)
, varMap = Map.empty