bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant{- |

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantModule : $Header$

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantDescription : ADL signature and sentences

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantCopyright : (c) Stef Joosten, Christian Maeder DFKI GmbH 2010

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantLicense : GPLv2 or higher, see LICENSE.txt

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantMaintainer : Christian.Maeder@dfki.de

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantStability : provisional

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantPortability : portable

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant

3437829f938dbb44527d91fbbc5f430a1243c5a5JnRouvignac-}

3437829f938dbb44527d91fbbc5f430a1243c5a5JnRouvignac

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantmodule Adl.Sign where

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantimport Adl.As

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantimport Adl.Print ()

3437829f938dbb44527d91fbbc5f430a1243c5a5JnRouvignac

3437829f938dbb44527d91fbbc5f430a1243c5a5JnRouvignacimport Common.AS_Annotation

3437829f938dbb44527d91fbbc5f430a1243c5a5JnRouvignacimport Common.Doc

3437829f938dbb44527d91fbbc5f430a1243c5a5JnRouvignacimport Common.DocUtils

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantimport Common.Id

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantimport Common.Result

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantimport qualified Common.Lib.Rel as Rel

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant

d81f6d00c343633159fc5ea08599d145135612c0ludovicpimport qualified Data.Map as Map

43cf232e238dd2e98c8b2badc91071b6ada52956gary.williamsimport qualified Data.Set as Set

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovanttype RelMap = Map.Map Id (Set.Set RelType)

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantdata Sign = Sign

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant { rels :: RelMap

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant , isas :: Rel.Rel Concept

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant } deriving (Eq, Ord, Show)

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantemptySign :: Sign

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantemptySign = Sign

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant { rels = Map.empty

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant , isas = Rel.empty }

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantcloseSign :: Sign -> Sign

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantcloseSign s = s { isas = Rel.transClosure $ isas s }

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantisSubSignOf :: Sign -> Sign -> Bool

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantisSubSignOf s1 s2 =

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant Map.isSubmapOfBy Set.isSubsetOf (rels s1) (rels s2)

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant && Rel.isSubrelOf (isas s1) (isas s2)

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantsignUnion :: Sign -> Sign -> Result Sign

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantsignUnion s1 s2 = return s1

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant { rels = Map.unionWith Set.union (rels s1) (rels s2)

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant , isas = Rel.union (isas s1) (isas s2) }

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantdata Symbol

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant = Con Concept

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant | Rel Relation

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant deriving (Eq, Ord, Show)

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantinstance GetRange Symbol where

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant getRange s = case s of

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant Rel r -> getRange r

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant Con c -> getRange c

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant rangeSpan s = case s of

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant Rel r -> rangeSpan r

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant Con c -> rangeSpan c

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantinstance Pretty Symbol where

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant pretty s = case s of

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant Rel r -> pretty r

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant Con c -> pretty c

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantconceptToId :: Concept -> Id

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantconceptToId c = case c of

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant C t -> simpleIdToId t

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant _ -> stringToId (show c)

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantsymName :: Symbol -> Id

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantsymName s = case s of

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant Rel r -> simpleIdToId $ decnm r

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant Con c -> conceptToId c

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantdata RawSymbol

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant = Symbol Symbol

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant | AnId Id

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant deriving (Eq, Ord, Show)

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantinstance GetRange RawSymbol where

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant getRange r = case r of

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant Symbol s -> getRange s

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant AnId i -> getRange i

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant rangeSpan r = case r of

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant Symbol s -> rangeSpan s

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant AnId i -> rangeSpan i

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantinstance Pretty RawSymbol where

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant pretty r = case r of

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant Symbol s -> pretty s

d81f6d00c343633159fc5ea08599d145135612c0ludovicp AnId i -> pretty i

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantsymMatch :: Symbol -> RawSymbol -> Bool

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantsymMatch s r = case r of

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant Symbol t -> s == t

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant AnId i -> symName s == i

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantidToSimpleId :: Id -> Token

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantidToSimpleId i = case i of

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant Id [t] [] _ -> t

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant _ -> error $ "idToSimpleId: " ++ show i

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantsymOf :: Sign -> Set.Set Symbol

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantsymOf = Set.unions . map (\ (i, l) ->

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant Set.fromList

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant . concatMap

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant (\ y -> let

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant s = relSrc y

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant t = relTrg y

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant in [Con s, Con t, Rel $ Sgn (idToSimpleId i) y])

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant $ Set.toList l)

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant . Map.toList . rels

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantinstance GetRange Sign where

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant getRange = getRange . symOf

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant rangeSpan = rangeSpan . symOf

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantinstance Pretty Sign where

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant pretty s =

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant vcat (map pretty $ concatMap (\ (i, l) ->

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant map (\ t -> Pm [] (Sgn (idToSimpleId i) t) False)

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant $ Set.toList l) $ Map.toList $ rels s)

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant $+$ vcat (map (\ (c1, c2) -> pretty $ Pg c1 c2)

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant . Rel.toList . Rel.transReduce . Rel.transClosure $ isas s)

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantdata Sen

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant = DeclProp Relation RangedProp

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant | Assertion (Maybe RuleKind) Rule

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant deriving (Eq, Ord, Show)

43cf232e238dd2e98c8b2badc91071b6ada52956gary.williams

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantinstance GetRange Sen where

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant getRange s = case s of

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant DeclProp _ p -> getRange p

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant Assertion _ r -> getRange r

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant rangeSpan s = case s of

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant DeclProp r p -> joinRanges [rangeSpan r, rangeSpan p]

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant Assertion _ r -> rangeSpan r

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantinstance Pretty Sen where

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant pretty s = case s of

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant DeclProp r p -> pretty $ Pm [p] r False

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant Assertion _ r -> pretty $ Pr Always r

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantprintNSen :: Named Sen -> Doc

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovantprintNSen ns = let

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant s = sentence ns

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant n = senAttr ns

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant d = pretty s

bc36152ff9a3ea2c2fa75ba2a64becfae0d96e5ecsovant in case s of

Assertion (Just k) r ->

pretty $ Pr (RuleHeader k $ mkSimpleId n) r

_ -> d <+> text ("-- " ++ n)