b87efd3db0d2dc41615ea28669faf80fc1b48d56Corneliu-Claudiu Prodescu{- |

f1edf379717f0ddb7607585a027cf6f03a6fce68Christian MaederModule : $Header$

f1edf379717f0ddb7607585a027cf6f03a6fce68Christian MaederDescription : abstract ADL syntax

98890889ffb2e8f6f722b00e265a211f13b5a861Corneliu-Claudiu ProdescuCopyright : (c) Stef Joosten, Christian Maeder DFKI GmbH 2010

b87efd3db0d2dc41615ea28669faf80fc1b48d56Corneliu-Claudiu ProdescuLicense : GPLv2 or higher

f1edf379717f0ddb7607585a027cf6f03a6fce68Christian Maeder

f1edf379717f0ddb7607585a027cf6f03a6fce68Christian MaederMaintainer : Christian.Maeder@dfki.de

f1edf379717f0ddb7607585a027cf6f03a6fce68Christian MaederStability : provisional

b87efd3db0d2dc41615ea28669faf80fc1b48d56Corneliu-Claudiu ProdescuPortability : portable

b87efd3db0d2dc41615ea28669faf80fc1b48d56Corneliu-Claudiu Prodescu

f1edf379717f0ddb7607585a027cf6f03a6fce68Christian Maeder-}

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowski

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowskimodule Adl.As where

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowski

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowskiimport Data.Char

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowskiimport Common.Id

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowskiimport Common.Keywords

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowski

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowskidata Concept

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowski = C Token -- ^ The name of this Concept

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowski | Anything -- ^ Really anything as introduced by I and V

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowski deriving (Eq, Ord, Show)

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowski

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowskiinstance GetRange Concept where

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowski getRange c = case c of

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowski C t -> getRange t

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowski Anything -> nullRange

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowski rangeSpan c = case c of

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowski C t -> rangeSpan t

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowski Anything -> []

9a80079e082fdf4fe8e19f8fc61e6cd8799b47a7Christian Maeder

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowskidata RelType = RelType

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowski { relSrc :: Concept -- ^ the source concept

9a80079e082fdf4fe8e19f8fc61e6cd8799b47a7Christian Maeder , relTrg :: Concept -- ^ the target concept

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowski } deriving (Eq, Ord, Show)

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowski

9a80079e082fdf4fe8e19f8fc61e6cd8799b47a7Christian Maederinstance GetRange RelType where

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowski getRange = getRange . relSrc

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowski rangeSpan (RelType c1 c2) =

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowski joinRanges [rangeSpan c1, rangeSpan c2]

9a80079e082fdf4fe8e19f8fc61e6cd8799b47a7Christian Maeder

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowskidata Relation = Sgn

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowski { decnm :: Token -- ^ the name

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowski , relType :: RelType

9a80079e082fdf4fe8e19f8fc61e6cd8799b47a7Christian Maeder } deriving (Eq, Ord, Show)

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowski

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowskiinstance GetRange Relation where

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowski getRange = getRange . decnm

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowski rangeSpan (Sgn n t) =

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowski joinRanges [rangeSpan n, rangeSpan t]

9a80079e082fdf4fe8e19f8fc61e6cd8799b47a7Christian Maeder

26db4a742376d513cdba128780ee8ca60eeb927eTill Mossakowski-- | builtin relation over Anything

26db4a742376d513cdba128780ee8ca60eeb927eTill MossakowskibRels :: [String]

bRels = ["I", "V"]

isBRel :: String -> Bool

isBRel s = elem s bRels

data UnOp

= K0 -- ^ Reflexive and transitive closure *

| K1 -- ^ Transitive closure +

| Cp -- ^ Complement -

| Co -- ^ Converse ~

deriving (Eq, Ord)

instance Show UnOp where

show o = case o of

K0 -> "*"

K1 -> "+"

Cp -> "-" -- prefix!

Co -> "~"

data MulOp

= Fc -- ^ composition ;

| Fd -- ^ relative addition !

| Fi -- ^ intersection /\.

| Fu -- ^ union \/

| Ri -- ^ Rule implication |-

| Rr -- ^ Rule reverse implication -|

| Re -- ^ Rule equivalence

deriving (Eq, Ord)

instance Show MulOp where

show o = case o of

Fc -> ";"

Fd -> "!"

Fi -> lAnd

Fu -> lOr

Ri -> "|-"

Rr -> "-|"

Re -> "="

data Rule

= Tm Relation

| MulExp MulOp [Rule]

| UnExp UnOp Rule

deriving (Eq, Ord, Show)

instance GetRange Rule where

getRange e = case e of

Tm r -> getRange r

UnExp _ f -> getRange f

MulExp _ es -> concatMapRange getRange es

rangeSpan e = case e of

Tm r -> rangeSpan r

UnExp _ f -> rangeSpan f

MulExp _ es -> joinRanges $ map rangeSpan es

data Prop

= Uni -- ^ univalent

| Inj -- ^ injective

| Sur -- ^ surjective

| Tot -- ^ total

| Sym -- ^ symmetric

| Asy -- ^ antisymmetric

| Trn -- ^ transitive

| Rfx -- ^ reflexive

| Prop -- ^ meta property

deriving (Enum, Eq, Ord, Show)

showUp :: Show a => a -> String

showUp = map toUpper . show

allProps :: [Prop]

allProps = [Uni .. Rfx]

data RangedProp = RangedProp

{ propProp :: Prop

, propRange :: Range }

deriving (Eq, Ord, Show) -- should be fine since ranges are always equal

instance GetRange RangedProp where

getRange = propRange

rangeSpan (RangedProp p r) = tokenRange (Token (show p) r)

-- | create a ranged property

rProp :: Prop -> RangedProp

rProp p = RangedProp p nullRange

data Object = Object

{ label :: Token

, expr :: Rule

, props :: [RangedProp]

, subobjs :: [Object]

} deriving Show

data KeyAtt = KeyAtt (Maybe Token) Rule deriving Show

instance GetRange KeyAtt where

getRange (KeyAtt _ e) = getRange e

rangeSpan (KeyAtt _ e) = rangeSpan e

data KeyDef = KeyDef

{ kdlbl :: Token

, kdcpt :: Concept

, kdats :: [KeyAtt]

} deriving Show

instance GetRange KeyDef where

getRange (KeyDef _ c _) = getRange c

rangeSpan (KeyDef _ c as) = joinRanges [rangeSpan c, rangeSpan as]

data RuleKind = SignalOn | Signals | Maintains deriving (Eq, Ord, Show)

showRuleKind :: RuleKind -> String

showRuleKind k = if k == SignalOn then "ON"

else showUp k

data RuleHeader = Always | RuleHeader RuleKind Token deriving Show

data Pair = Pair Token Token deriving Show

data Plugin = Service | Sqlplug | Phpplug deriving Show

data PatElem

= Pr RuleHeader Rule

| Pg Concept Concept -- specific and generic concept

| Pk KeyDef

| Pm [RangedProp] Relation Bool -- True indicates population

| Plug Plugin Object

| Population Bool Relation [Pair] -- True indicates declaration

deriving Show

data Context = Context (Maybe Token) [PatElem] deriving Show

instance GetRange Context where

getRange (Context mt _) = getRange mt