Sign.hs revision 1a38107941725211e7c3f051f7a8f5e12199f03a
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elkner{-# LANGUAGE DeriveDataTypeable #-}
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elkner{- |
43b4c41fbb07705c9df321221ab9cb9832460407Christian MaederModule : $Header$
a84a8d508a0778b13a4d097a6dd34b95feae78acJens ElknerDescription : signatures for FPL
a84a8d508a0778b13a4d097a6dd34b95feae78acJens ElknerCopyright : (c) Christian Maeder, DFKI GmbH 2011
a84a8d508a0778b13a4d097a6dd34b95feae78acJens ElknerLicense : GPLv2 or higher, see LICENSE.txt
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian MaederMaintainer : Christian.Maeder@dfki.de
a84a8d508a0778b13a4d097a6dd34b95feae78acJens ElknerStability : provisional
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian MaederPortability : portable
d23ecf32e56cce69bc42eb5c96dddf7909c623abjelmd
d23ecf32e56cce69bc42eb5c96dddf7909c623abjelmdsignature extension for FPL to keep track of constructors
d23ecf32e56cce69bc42eb5c96dddf7909c623abjelmd-}
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elknermodule Fpl.Sign where
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elknerimport Fpl.As
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elkner
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elknerimport Common.AS_Annotation
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elknerimport Common.Doc
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elknerimport Common.DocUtils
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elknerimport Common.Id
d23ecf32e56cce69bc42eb5c96dddf7909c623abjelmdimport Common.Keywords
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elknerimport qualified Common.Lib.MapSet as MapSet
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elknerimport qualified Common.Lib.Rel as Rel
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elkner
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elknerimport CASL.Sign
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elknerimport CASL.AS_Basic_CASL
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elknerimport CASL.ToDoc
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elkner
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elknerimport Data.Data
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elknerimport Data.List
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elknerimport Data.Ord
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elkner
a84a8d508a0778b13a4d097a6dd34b95feae78acJens ElknerboolSort :: Id
a84a8d508a0778b13a4d097a6dd34b95feae78acJens ElknerboolSort = stringToId "Bool"
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elkner
a84a8d508a0778b13a4d097a6dd34b95feae78acJens ElknertrueC :: Id
f8597aabc9db75dcf504e3151faf220a165c90d1Eugen KuksatrueC = stringToId trueS
f8597aabc9db75dcf504e3151faf220a165c90d1Eugen Kuksa
f8597aabc9db75dcf504e3151faf220a165c90d1Eugen KuksafalseC :: Id
f8597aabc9db75dcf504e3151faf220a165c90d1Eugen KuksafalseC = stringToId falseS
ab4256496e72886018b78571057331f373da6883Eugen Kuksa
f8597aabc9db75dcf504e3151faf220a165c90d1Eugen KuksaboolType :: OpType
f8597aabc9db75dcf504e3151faf220a165c90d1Eugen KuksaboolType = sortToOpType boolSort
f8597aabc9db75dcf504e3151faf220a165c90d1Eugen Kuksa
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksadata SignExt = SignExt
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa { constr :: OpMap }
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa deriving (Show, Eq, Ord, Typeable, Data)
a389e88e0acb83d8489bdc5e55bc5522b152bbecEugen Kuksa
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elknerinstance Pretty SignExt where
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elkner pretty es = let nr = nullRange in case
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elkner groupBy (\ (_, c1) (_, c2) -> opRes c1 == opRes c2)
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elkner $ sortBy (comparing (opRes . snd))
60e6795dd310e10194e12bb660575aadf941328bEugen Kuksa $ mapSetToList $ constr es of
60e6795dd310e10194e12bb660575aadf941328bEugen Kuksa [] -> empty
60e6795dd310e10194e12bb660575aadf941328bEugen Kuksa l -> topSigKey (sortS ++ appendS l) <+> sepBySemis
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elkner (map (\ g -> printDD
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elkner (Datatype_decl (opRes $ snd $ head g)
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elkner (map (\ (i, t) -> emptyAnno $
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elkner Alt_construct Total i (map Sort $ opArgs t) nr)
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elkner g) nr)) l)
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elkner
a84a8d508a0778b13a4d097a6dd34b95feae78acJens ElkneremptyFplSign :: SignExt
60e6795dd310e10194e12bb660575aadf941328bEugen KuksaemptyFplSign = SignExt MapSet.empty
c9a7e6af169a2adfb92f42331cd578065ed83a2bChristian Maeder
e7757995211bd395dc79d26fe017d99375f7d2a6Christian MaederdiffFplSign :: SignExt -> SignExt -> SignExt
e7757995211bd395dc79d26fe017d99375f7d2a6Christian MaederdiffFplSign a b = a
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder { constr = constr a `diffOpMapSet` constr b }
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder
c0c2380bced8159ff0297ece14eba948bd236471Christian MaederaddFplSign :: SignExt -> SignExt -> SignExt
404166b9366552e9ec5abb87a37c76ec8a815fb7Klaus LuettichaddFplSign a b = a
b1f59a4ea7c96f4c03a4d7cfcb9c5e66871cfbbbChristian Maeder { constr = addOpMapSet (constr a) $ constr b }
ad270004874ce1d0697fb30d7309f180553bb315Christian Maeder
404166b9366552e9ec5abb87a37c76ec8a815fb7Klaus LuettichinterFplSign :: SignExt -> SignExt -> SignExt
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian MaederinterFplSign a b = a
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder { constr = interOpMapSet (constr a) $ constr b }
1a38107941725211e7c3f051f7a8f5e12199f03acmaeder
ce5b44277ea06257548ff625e928cb1290c6d297cmaederisSubFplSign :: SignExt -> SignExt -> Bool
bab2d88d650448628730ed3b65c9f99c52500e8cChristian MaederisSubFplSign s1 s2 = isSubOpMap (constr s1) (constr s2)
fa8878c6145f652f615a04a5e9c15a1d1327bc92cmaeder
ce5b44277ea06257548ff625e928cb1290c6d297cmaedertype FplSign = Sign TermExt SignExt
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian Maeder
63f0e65a37b95621334db9ee4ba0cd9d826f5c0fChristian MaederaddBools :: OpMap -> OpMap
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian MaederaddBools = addOpTo falseC boolType . addOpTo trueC boolType
3dde4051c307b609159a097f08a05108fdd036efJonathan von Schroeder
3dde4051c307b609159a097f08a05108fdd036efJonathan von SchroederaddConsts :: SignExt -> SignExt
3dde4051c307b609159a097f08a05108fdd036efJonathan von SchroederaddConsts s = s { constr = addBools $ constr s }
3dde4051c307b609159a097f08a05108fdd036efJonathan von Schroeder
3dde4051c307b609159a097f08a05108fdd036efJonathan von SchroederaddBuiltins :: FplSign -> FplSign
3dde4051c307b609159a097f08a05108fdd036efJonathan von SchroederaddBuiltins s = s { sortRel = Rel.insertKey boolSort $ sortRel s
3dde4051c307b609159a097f08a05108fdd036efJonathan von Schroeder , opMap = addBools $ opMap s
3dde4051c307b609159a097f08a05108fdd036efJonathan von Schroeder , extendedInfo = addConsts $ extendedInfo s }
3dde4051c307b609159a097f08a05108fdd036efJonathan von Schroeder
3dde4051c307b609159a097f08a05108fdd036efJonathan von SchroederdelBuiltins :: FplSign -> FplSign
3dde4051c307b609159a097f08a05108fdd036efJonathan von SchroederdelBuiltins s = diffSig diffFplSign s $ addBuiltins $ emptySign emptyFplSign
825a1e4ca1e768de4b4883c65a6cb1dce6aa0002Christian Maeder