{-# LANGUAGE DeriveDataTypeable #-}
{- |
Module : ./CommonLogic/Sign.hs
Description : Signature for common logic
Copyright : (c) Karl Luc, DFKI Bremen 2010
License : GPLv2 or higher, see LICENSE.txt
Maintainer : kluc@informatik.uni-bremen.de
Stability : experimental
Portability : portable
Definition of signatures for common logic
-}
module CommonLogic.Sign
(Sign (..)
, pretty -- pretty printing
, allItems -- union of all signature-fields
, emptySig -- empty signature
, isSubSigOf -- sub signature of signature
, sigDiff -- Difference of Signatures
, unite -- union of signatures
, uniteL -- union of a list ofsignatures
, sigUnion -- Union for Logic.Logic
, sigUnionL -- union of a list ofsignatures
, isSeqMark -- is an Id a sequence marker?
) where
import qualified Data.Set as Set
import Common.Id
import Common.Result
import Common.Doc
import Common.DocUtils
import Data.Data
import Data.List (isPrefixOf)
-- | Datatype for common logic Signatures
data Sign = Sign { discourseNames :: Set.Set Id
, nondiscourseNames :: Set.Set Id
, sequenceMarkers :: Set.Set Id
} deriving (Eq, Ord, Show, Typeable)
instance Pretty Sign where
pretty = printSign
-- | union of all signature-fields
allItems :: Sign -> Set.Set Id
allItems s = Set.unions $ map (\ f -> f s) [ discourseNames
, nondiscourseNames
, sequenceMarkers
]
-- | The empty signature
emptySig :: Sign
emptySig = Sign { discourseNames = Set.empty
, nondiscourseNames = Set.empty
, sequenceMarkers = Set.empty
}
-- | pretty printing for Signatures
printSign :: Sign -> Doc
printSign s =
vsep [ text "%{"
, text "discourseNames: "
<+> sepByCommas (map pretty $ Set.toList $ discourseNames s)
, text "nondiscourseNames: "
<+> sepByCommas (map pretty $ Set.toList $ nondiscourseNames s)
, text "sequenceMarkers: "
<+> sepByCommas (map pretty $ Set.toList $ sequenceMarkers s)
, text "}%"]
-- | Determines if sig1 is subsignature of sig2
isSubSigOf :: Sign -> Sign -> Bool
isSubSigOf sig1 sig2 =
Set.isSubsetOf (discourseNames sig1) (discourseNames sig2)
&& Set.isSubsetOf (nondiscourseNames sig1) (nondiscourseNames sig2)
&& Set.isSubsetOf (sequenceMarkers sig1) (sequenceMarkers sig2)
-- | difference of Signatures
sigDiff :: Sign -> Sign -> Sign
sigDiff sig1 sig2 = Sign {
discourseNames = Set.difference (discourseNames sig1) (discourseNames sig2),
nondiscourseNames = Set.difference (nondiscourseNames sig1) (nondiscourseNames sig2),
sequenceMarkers = Set.difference (sequenceMarkers sig1) (sequenceMarkers sig2)
}
-- | Unite Signatures
sigUnion :: Sign -> Sign -> Result Sign
sigUnion s1 = Result [Diag Debug "All fine sigUnion" nullRange]
. Just . unite s1
-- | Unite Signature in a list
sigUnionL :: [Sign] -> Result Sign
sigUnionL (sig : sigL) = sigUnion sig (uniteL sigL)
sigUnionL [] = return emptySig
-- | Union of two signatures. Behaves like Set.union, i.e. is fast with @bigsig `union` smallsig@.
unite :: Sign -> Sign -> Sign
unite sig1 sig2 = Sign
{ discourseNames = discourseNames sig1 `Set.union` discourseNames sig2
, nondiscourseNames = nondiscourseNames sig1 `Set.union` nondiscourseNames sig2
, sequenceMarkers = sequenceMarkers sig1 `Set.union` sequenceMarkers sig2
}
-- | Union of a list of signatures.
uniteL :: [Sign] -> Sign
uniteL = foldr unite emptySig
isSeqMark :: Id -> Bool
isSeqMark = isStringSeqMark . tokStr . idToSimpleId
-- | Checks whether a String is a sequence marker
isStringSeqMark :: String -> Bool
isStringSeqMark s = "..." `isPrefixOf` s