Sign.hs revision 7ad21cf90b1053c2fa8f97535235a83a0678fc64
bff4b3f816be4c1e1d8ded76f1d5af786839e1a9Christian MaederModule : $Header$
bff4b3f816be4c1e1d8ded76f1d5af786839e1a9Christian MaederDescription : signatures for FPL
bff4b3f816be4c1e1d8ded76f1d5af786839e1a9Christian MaederCopyright : (c) Christian Maeder, DFKI GmbH 2011
bff4b3f816be4c1e1d8ded76f1d5af786839e1a9Christian MaederLicense : GPLv2 or higher, see LICENSE.txt
bff4b3f816be4c1e1d8ded76f1d5af786839e1a9Christian MaederMaintainer : Christian.Maeder@dfki.de
bff4b3f816be4c1e1d8ded76f1d5af786839e1a9Christian MaederStability : provisional
bff4b3f816be4c1e1d8ded76f1d5af786839e1a9Christian MaederPortability : portable
bff4b3f816be4c1e1d8ded76f1d5af786839e1a9Christian Maedersignature extension for FPL to keep track of constructors
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian Maederimport qualified Common.Lib.MapSet as MapSet
e0f1794e365dd347e97b37d7d22b2fce27296fa1Christian Maederimport qualified Common.Lib.Rel as Rel
1aa11f4e4b984f2a6d6ce9700cbe82283c8d196aChristian MaederboolSort :: Id
1aa11f4e4b984f2a6d6ce9700cbe82283c8d196aChristian MaederboolSort = stringToId "Bool"
e935c1f2e814bb143017bb25b32ff7a406299d37Christian MaedertrueC = stringToId trueS
e935c1f2e814bb143017bb25b32ff7a406299d37Christian MaederfalseC = stringToId falseS
e935c1f2e814bb143017bb25b32ff7a406299d37Christian MaederboolType :: OpType
e7ddd5495421698701a2bbc57a5b3390a11d12caChristian MaederboolType = sortToOpType boolSort
bff4b3f816be4c1e1d8ded76f1d5af786839e1a9Christian Maederdata SignExt = SignExt
e935c1f2e814bb143017bb25b32ff7a406299d37Christian Maeder { constr :: OpMap }
bff4b3f816be4c1e1d8ded76f1d5af786839e1a9Christian Maeder deriving (Show, Eq, Ord)
f6cea53c107f81a3f3225481f1673452e29c555cChristian Maederinstance Pretty SignExt where
4bbd808612c2580ae6e0495a155997a6bb47ecf3Christian Maeder pretty es = let nr = nullRange in case
4bbd808612c2580ae6e0495a155997a6bb47ecf3Christian Maeder groupBy (\ (_, c1) (_, c2) -> opRes c1 == opRes c2)
4bbd808612c2580ae6e0495a155997a6bb47ecf3Christian Maeder $ sortBy (comparing (opRes . snd))
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian Maeder $ mapSetToList $ constr es of
4bbd808612c2580ae6e0495a155997a6bb47ecf3Christian Maeder l -> topSigKey (sortS ++ appendS l) <+> sepBySemis
4bbd808612c2580ae6e0495a155997a6bb47ecf3Christian Maeder (map (\ g -> printDD
4bbd808612c2580ae6e0495a155997a6bb47ecf3Christian Maeder (Datatype_decl (opRes $ snd $ head g)
4bbd808612c2580ae6e0495a155997a6bb47ecf3Christian Maeder (map (\ (i, t) -> emptyAnno $
4bbd808612c2580ae6e0495a155997a6bb47ecf3Christian Maeder Alt_construct Total i (map Sort $ opArgs t) nr)
bff4b3f816be4c1e1d8ded76f1d5af786839e1a9Christian MaederemptyFplSign :: SignExt
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian MaederemptyFplSign = SignExt MapSet.empty
e935c1f2e814bb143017bb25b32ff7a406299d37Christian MaederdiffFplSign :: SignExt -> SignExt -> SignExt
e935c1f2e814bb143017bb25b32ff7a406299d37Christian MaederdiffFplSign a b = a
e935c1f2e814bb143017bb25b32ff7a406299d37Christian Maeder { constr = constr a `diffOpMapSet` constr b }
bff4b3f816be4c1e1d8ded76f1d5af786839e1a9Christian MaederaddFplSign :: SignExt -> SignExt -> SignExt
e935c1f2e814bb143017bb25b32ff7a406299d37Christian MaederaddFplSign a b = a
e935c1f2e814bb143017bb25b32ff7a406299d37Christian Maeder { constr = addOpMapSet (constr a) $ constr b }
e935c1f2e814bb143017bb25b32ff7a406299d37Christian MaederinterFplSign :: SignExt -> SignExt -> SignExt
e935c1f2e814bb143017bb25b32ff7a406299d37Christian MaederinterFplSign a b = a
e935c1f2e814bb143017bb25b32ff7a406299d37Christian Maeder { constr = interOpMapSet (constr a) $ constr b }
bff4b3f816be4c1e1d8ded76f1d5af786839e1a9Christian MaederisSubFplSign :: SignExt -> SignExt -> Bool
e935c1f2e814bb143017bb25b32ff7a406299d37Christian MaederisSubFplSign s1 s2 = isSubOpMap (constr s1) (constr s2)
e935c1f2e814bb143017bb25b32ff7a406299d37Christian Maedertype FplSign = Sign TermExt SignExt
e935c1f2e814bb143017bb25b32ff7a406299d37Christian MaederaddBools :: OpMap -> OpMap
e935c1f2e814bb143017bb25b32ff7a406299d37Christian MaederaddBools = addOpTo falseC boolType . addOpTo trueC boolType
e935c1f2e814bb143017bb25b32ff7a406299d37Christian MaederaddConsts :: SignExt -> SignExt
e935c1f2e814bb143017bb25b32ff7a406299d37Christian MaederaddConsts s = s { constr = addBools $ constr s }
e935c1f2e814bb143017bb25b32ff7a406299d37Christian MaederaddBuiltins :: FplSign -> FplSign
e0f1794e365dd347e97b37d7d22b2fce27296fa1Christian MaederaddBuiltins s = s { sortRel = Rel.insertKey boolSort $ sortRel s
e935c1f2e814bb143017bb25b32ff7a406299d37Christian Maeder , opMap = addBools $ opMap s
e935c1f2e814bb143017bb25b32ff7a406299d37Christian Maeder , extendedInfo = addConsts $ extendedInfo s }
e935c1f2e814bb143017bb25b32ff7a406299d37Christian MaederdelBuiltins :: FplSign -> FplSign
e935c1f2e814bb143017bb25b32ff7a406299d37Christian MaederdelBuiltins s = diffSig diffFplSign s $ addBuiltins $ emptySign emptyFplSign