hets/Fpl/Sign.hs

	Sign.hs revision bff4b3f816be4c1e1d8ded76f1d5af786839e1a9
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elkner{- |
a84a8d508a0778b13a4d097a6dd34b95feae78acJens ElknerModule      :  $Header$
43b4c41fbb07705c9df321221ab9cb9832460407Christian MaederDescription :  signatures for FPL
a84a8d508a0778b13a4d097a6dd34b95feae78acJens ElknerCopyright   :  (c) Christian Maeder, DFKI GmbH 2011
a84a8d508a0778b13a4d097a6dd34b95feae78acJens ElknerLicense     :  GPLv2 or higher, see LICENSE.txt
a84a8d508a0778b13a4d097a6dd34b95feae78acJens ElknerMaintainer  :  Christian.Maeder@dfki.de
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian MaederStability   :  provisional
a84a8d508a0778b13a4d097a6dd34b95feae78acJens ElknerPortability :  portable
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maedersignature extension for FPL to keep track of constructors
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elkner-}
5191fa24c532d1f67e7a642e9aece65efb8a0975Christian Maeder
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elknermodule Fpl.Sign where
f2f9df2e17e70674f0bf426ed1763c973ee4cde0Christian Maeder
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elknerimport Common.DocUtils
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elknerimport Common.Id
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elkner
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elknerimport CASL.Sign
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elkner
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elknerimport qualified Data.Map as Map
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elknerimport qualified Data.Set as Set
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elkner
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elknerdata SignExt = SignExt
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elkner  { constr :: Map.Map Id OpType
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elkner  , freetypes :: Map.Map Id (Set.Set (Id, OpType)) }
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elkner  deriving (Show, Eq, Ord)
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elkner
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elknerinstance Pretty SignExt
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elkner
a84a8d508a0778b13a4d097a6dd34b95feae78acJens ElkneremptyFplSign :: SignExt
a84a8d508a0778b13a4d097a6dd34b95feae78acJens ElkneremptyFplSign = SignExt Map.empty Map.empty
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elkner
a84a8d508a0778b13a4d097a6dd34b95feae78acJens ElkneraddFplSign :: SignExt -> SignExt -> SignExt
a84a8d508a0778b13a4d097a6dd34b95feae78acJens ElkneraddFplSign s1 s2 = s1
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elkner  { constr = Map.union (constr s1) $ constr s2
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elkner  , freetypes = Map.unionWith Set.union (freetypes s1) $ freetypes s2 }
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elkner
a84a8d508a0778b13a4d097a6dd34b95feae78acJens ElknerisSubFplSign :: SignExt -> SignExt -> Bool
a84a8d508a0778b13a4d097a6dd34b95feae78acJens ElknerisSubFplSign s1 s2 =
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elkner  Map.isSubmapOf (constr s1) (constr s2) &&
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elkner  Map.isSubmapOf (freetypes s1) (freetypes s2)
a84a8d508a0778b13a4d097a6dd34b95feae78acJens Elkner