Parse.hs revision d11226f9a86c35c7082cd29cd171ec59d829ffa0
e83ed59502a681713982f25c559aae77a4145734Christian Maeder{- |
eb483f2216949400bfef8f6deb5320f071445626Christian MaederModule : $Header$
e6d40133bc9f858308654afb1262b8b483ec5922Till MossakowskiDescription : ADL syntax parser
eb483f2216949400bfef8f6deb5320f071445626Christian MaederCopyright : (c) Stef Joosten, Christian Maeder DFKI GmbH 2010
98890889ffb2e8f6f722b00e265a211f13b5a861Corneliu-Claudiu ProdescuLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder
3f69b6948966979163bdfe8331c38833d5d90ecdChristian MaederMaintainer : Christian.Maeder@dfki.de
eb483f2216949400bfef8f6deb5320f071445626Christian MaederStability : provisional
eb483f2216949400bfef8f6deb5320f071445626Christian MaederPortability : portable
f3a94a197960e548ecd6520bb768cb0d547457bbChristian Maeder
e6d40133bc9f858308654afb1262b8b483ec5922Till Mossakowski-}
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder
585094c4284ed39eb8024cc1178c823c403200faChristian Maedermodule Adl.Parse where
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maederimport Adl.As
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maederimport Common.Id
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maederimport Common.Lexer (parseToken)
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maederimport Common.Parsec
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maederimport Common.Token (casl_structured_reserved_words)
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maederimport Control.Monad
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maederimport Text.ParserCombinators.Parsec
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maederkeywordstxt :: [String]
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maederkeywordstxt =
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder [ "CONTEXT", "ENDCONTEXT", "EXTENDS"
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder , "PATTERN", "ENDPATTERN"
e83ed59502a681713982f25c559aae77a4145734Christian Maeder , "SERVICE", "INITIAL", "SQLPLUG", "PHPPLUG"
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder , "POPULATION", "CONTAINS"
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder , "UNI", "INJ", "SUR", "TOT", "SYM", "ASY", "TRN", "RFX", "PROP", "ALWAYS"
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder , "RULE", "MAINTAINS", "SIGNALS", "SIGNAL", "ON"
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder , "RELATION", "CONCEPT", "KEY"
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder , "IMPORT", "GEN", "ISA", "I", "V", "S"
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder , "PRAGMA", "EXPLANATION", "EXPLAIN", "IN", "REF", "ENGLISH", "DUTCH"
e83ed59502a681713982f25c559aae77a4145734Christian Maeder , "ONE", "BIND", "TOPHP", "BINDING"
e83ed59502a681713982f25c559aae77a4145734Christian Maeder ]
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder
e83ed59502a681713982f25c559aae77a4145734Christian Maeder-- | a line comment starts with --. In haskell this may be part of an operator.
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaederlineComment :: CharParser st String
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaederlineComment = tryString "--" <++> many (noneOf "\n")
e83ed59502a681713982f25c559aae77a4145734Christian Maeder
e83ed59502a681713982f25c559aae77a4145734Christian Maederskip :: CharParser st ()
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maederskip = skipMany $ forget space
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder <|> forget (nestedComment "{-" "-}" <|> lineComment)
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder
e83ed59502a681713982f25c559aae77a4145734Christian MaederpChar :: CharParser st Char
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaederpChar = alphaNum <|> oneOf "_'"
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder
e83ed59502a681713982f25c559aae77a4145734Christian MaederpKeyS :: String -> CharParser st String
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaederpKeyS s = try (string s << notFollowedBy pChar) << skip
e83ed59502a681713982f25c559aae77a4145734Christian Maeder
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaederpKey :: String -> CharParser st ()
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaederpKey = forget . pKeyS
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaederpSymC :: String -> String -> CharParser st String
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaederpSymC s cs = try (string s << notFollowedBy (oneOf cs)) << skip
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder-- do not parse a double colon
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaederpColon :: CharParser st String
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaederpColon = pSymC ":" ":"
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder-- do not parse --, ->, or -|
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaederpMinus :: CharParser st String
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaederpMinus = pSymC "-" "->|"
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaederpSymS :: String -> CharParser st String
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaederpSymS s = tryString s << skip
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaederpSym :: String -> CharParser st ()
2eb84fc82d3ffa9116bc471fda3742bd9e5a24bbChristian MaederpSym = forget . pSymS
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder
10b02b2343246df6773585636fe3ddbefa3b6a1bChristian MaederpComma :: CharParser st ()
2eb84fc82d3ffa9116bc471fda3742bd9e5a24bbChristian MaederpComma = pSym ","
2eb84fc82d3ffa9116bc471fda3742bd9e5a24bbChristian Maeder
10b02b2343246df6773585636fe3ddbefa3b6a1bChristian MaederpEqual :: CharParser st ()
10b02b2343246df6773585636fe3ddbefa3b6a1bChristian MaederpEqual = pSym "="
35db0960aa2e2a13652381c756fae5fb2b27213bChristian Maeder
42c01284bba8d7c8d995c8dfb96ace57d28ed1bcTill MossakowskipGenParens :: String -> String -> CharParser st a -> CharParser st a
eb483f2216949400bfef8f6deb5320f071445626Christian MaederpGenParens o c p =
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder pSym o >> p << pSym c
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder
eb483f2216949400bfef8f6deb5320f071445626Christian MaederpParens :: CharParser st a -> CharParser st a
07b1bf56f3a486f26d69514d05b73100abb25a0eChristian MaederpParens = pGenParens "(" ")"
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder
eb483f2216949400bfef8f6deb5320f071445626Christian MaederpSqBrackets :: CharParser st a -> CharParser st a
eb483f2216949400bfef8f6deb5320f071445626Christian MaederpSqBrackets = pGenParens "[" "]"
e83ed59502a681713982f25c559aae77a4145734Christian Maeder
eb483f2216949400bfef8f6deb5320f071445626Christian MaederpConid :: CharParser st String
eb483f2216949400bfef8f6deb5320f071445626Christian MaederpConid = reserved keywordstxt (upper <:> many pChar) << skip
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaederpVarid :: CharParser st String
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaederpVarid = reserved casl_structured_reserved_words (lower <:> many pChar) << skip
083679daeba30fce9d60f7170a2cfd9f9c80bfb2Till Mossakowski
083679daeba30fce9d60f7170a2cfd9f9c80bfb2Till MossakowskipString :: CharParser st String
083679daeba30fce9d60f7170a2cfd9f9c80bfb2Till MossakowskipString = (stringLit <|> sQuoted) << skip
e33e3b425e953236b4617870f995d263ac35b883Christian Maeder
58564afba8f0bb6b57783c4b440d0b666edf5f67Christian MaederpADLid :: CharParser st Token
e83ed59502a681713982f25c559aae77a4145734Christian MaederpADLid = parseToken $ pConid <|> pVarid <|> pString
e33e3b425e953236b4617870f995d263ac35b883Christian Maeder
3a3bbc51abf804d91bc9d8e0f2ce745cfae4c9c7Christian Maeder-- | parse contexts but do not require CONTEXT blocks
083679daeba30fce9d60f7170a2cfd9f9c80bfb2Till MossakowskipArchitecture :: CharParser st Context
083679daeba30fce9d60f7170a2cfd9f9c80bfb2Till MossakowskipArchitecture = fmap Context $ flat $ many1
083679daeba30fce9d60f7170a2cfd9f9c80bfb2Till Mossakowski $ pContext <|> flat (many1 pContextElement)
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian Maeder
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian MaederpContext :: CharParser st [PatElem]
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian MaederpContext = do
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian Maeder pKey "CONTEXT"
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian Maeder pConid
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian Maeder option () $ do
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian Maeder pColon
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian Maeder pExpr
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian Maeder forget $ optionL $ do
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian Maeder pKey "BINDING"
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian Maeder sepBy1 pBind pComma
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian Maeder optionL $ do
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian Maeder pKey "EXTENDS"
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian Maeder sepBy1 pConid pComma
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian Maeder ps <- many pContextElement
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian Maeder pKey "ENDCONTEXT"
743178d5294deadc2ed15e56b5e58ca0e7101fe4Christian Maeder return $ concat ps
72b8c0349a58cf0eb361cb5bb410d95a0372900acmaeder
743178d5294deadc2ed15e56b5e58ca0e7101fe4Christian MaederpBind :: CharParser st String
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian MaederpBind = pKey "BIND" >> pDeclaration << pKey "TOPHP" >> (pConid <|> pString)
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian Maeder
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian Maeder-- | parse a context element but do not require the PATTERN block
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian MaederpContextElement :: CharParser st [PatElem]
743178d5294deadc2ed15e56b5e58ca0e7101fe4Christian MaederpContextElement = pPattern <|> flat (many1 pPatElem)
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian Maeder <|> single (pObjDef <|> pPopulation)
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian Maeder <|> pSqlplug <|> pPhpplug
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian Maeder
f30760456a3b6f7d4d54c65323dbc73cceca68fbChristian MaederpPopulation :: CharParser st PatElem
743178d5294deadc2ed15e56b5e58ca0e7101fe4Christian MaederpPopulation = do
743178d5294deadc2ed15e56b5e58ca0e7101fe4Christian Maeder pKey "POPULATION"
083679daeba30fce9d60f7170a2cfd9f9c80bfb2Till Mossakowski r <- pMorphism
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder pKey "CONTAINS"
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder pContent False r
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder
7e4157a70efe2acab30dbe5079bba6db90923785Christian MaederpPattern :: CharParser st [PatElem]
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaederpPattern = pKey "PATTERN" >> (pConid <|> pString)
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder >> flat (many pPatElem)
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder << pKey "ENDPATTERN"
1865083b72c1307e9040d78c2743abd5a54ee260Christian Maeder
eb483f2216949400bfef8f6deb5320f071445626Christian MaederpPatElem :: CharParser st [PatElem]
eb483f2216949400bfef8f6deb5320f071445626Christian MaederpPatElem = pDeclaration <|> pConceptDef <|> pExplain
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder <|> single (pRuleDef <|> pGen <|> pKeyDef)
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaederpDeclaration :: CharParser st [PatElem]
c58a5efdb3c9fbc80deb1c69716f09c67292a41dChristian MaederpDeclaration = do
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder n <- try $ parseToken pVarid << pSym "::"
585094c4284ed39eb8024cc1178c823c403200faChristian Maeder c1 <- pConcept
585094c4284ed39eb8024cc1178c823c403200faChristian Maeder s <- parseToken $ pSymS "*" <|> pSymS "->"
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder let ps = if tokStr s == "->" then
e83ed59502a681713982f25c559aae77a4145734Christian Maeder map (flip RangedProp $ tokPos s) [Uni, Tot] else []
e83ed59502a681713982f25c559aae77a4145734Christian Maeder c2 <- pConcept
e953bea49e7f0e1a43bccf2a66c5e2a2b50848e0Christian Maeder as <- optionL pProps
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder optionL pPragma
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder optionL $ do
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder pKey "EXPLANATION"
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder pString
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder let r = Sgn n c1 c2
dc427a9450cd7b463717a2255c804afa47a54365Christian Maeder p <- optionL $ do
dc427a9450cd7b463717a2255c804afa47a54365Christian Maeder pEqual
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder single $ pContent True r
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder pSym "."
dc427a9450cd7b463717a2255c804afa47a54365Christian Maeder return $ Pm (ps ++ as) r (not $ null p) : p
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder
585094c4284ed39eb8024cc1178c823c403200faChristian MaederpRangedProp :: Prop -> CharParser st RangedProp
585094c4284ed39eb8024cc1178c823c403200faChristian MaederpRangedProp p = liftM2 (flip RangedProp)
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder (liftM tokPos $ parseToken $ pKeyS $ showProp p) $ return p
e64aab3e57d843884cd489cc3aa130120a400b05Christian Maeder
eb483f2216949400bfef8f6deb5320f071445626Christian MaederpProps :: CharParser st [RangedProp]
eb483f2216949400bfef8f6deb5320f071445626Christian MaederpProps = pSqBrackets $ sepBy
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder (choice $ map pRangedProp allProps) pComma
e83ed59502a681713982f25c559aae77a4145734Christian Maeder
e953bea49e7f0e1a43bccf2a66c5e2a2b50848e0Christian MaederpPragma :: CharParser st [String]
e64aab3e57d843884cd489cc3aa130120a400b05Christian MaederpPragma = pKey "PRAGMA" >> many1 pString
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder
eb483f2216949400bfef8f6deb5320f071445626Christian MaederpConceptDef :: CharParser st [PatElem]
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaederpConceptDef = do
e64aab3e57d843884cd489cc3aa130120a400b05Christian Maeder pKey "CONCEPT"
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder pConcept
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder pString
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder optionL pString
e64aab3e57d843884cd489cc3aa130120a400b05Christian Maeder return []
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder
585094c4284ed39eb8024cc1178c823c403200faChristian MaederpKeyDef :: CharParser st PatElem
585094c4284ed39eb8024cc1178c823c403200faChristian MaederpKeyDef = do
585094c4284ed39eb8024cc1178c823c403200faChristian Maeder pKey "KEY"
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder t <- pLabelProps
e64aab3e57d843884cd489cc3aa130120a400b05Christian Maeder c <- pConcept
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder l <- pParens $ sepBy1 pKeyAtt pComma
585094c4284ed39eb8024cc1178c823c403200faChristian Maeder return $ Pk $ KeyDef t c l
585094c4284ed39eb8024cc1178c823c403200faChristian Maeder
eb483f2216949400bfef8f6deb5320f071445626Christian MaederpLabelProps :: CharParser st Token
e83ed59502a681713982f25c559aae77a4145734Christian MaederpLabelProps = do
e83ed59502a681713982f25c559aae77a4145734Christian Maeder n <- pADLid
e64aab3e57d843884cd489cc3aa130120a400b05Christian Maeder optionL $ pGenParens "{" "}" $ sepBy1 pADLid pComma
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder pColon
585094c4284ed39eb8024cc1178c823c403200faChristian Maeder return n
585094c4284ed39eb8024cc1178c823c403200faChristian Maeder
eb483f2216949400bfef8f6deb5320f071445626Christian MaederpKeyAtt :: CharParser st KeyAtt
7e4157a70efe2acab30dbe5079bba6db90923785Christian MaederpKeyAtt = liftM2 KeyAtt (optionMaybe $ try pLabelProps) pExpr
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder
25a0b76bc87e80c0f697951d9817862755a71d33Christian MaederpObjDef :: CharParser st PatElem
eb483f2216949400bfef8f6deb5320f071445626Christian MaederpObjDef = pKey "SERVICE" >> fmap Service pObj
e64aab3e57d843884cd489cc3aa130120a400b05Christian Maeder
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaederpObj :: CharParser st Object
585094c4284ed39eb8024cc1178c823c403200faChristian MaederpObj = do
585094c4284ed39eb8024cc1178c823c403200faChristian Maeder n <- pLabelProps
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder e <- pExpr
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder as <- optionL (pKey "ALWAYS" >> many pProp')
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder os <- optionL (pEqual >> pSqBrackets (sepBy pObj pComma))
585094c4284ed39eb8024cc1178c823c403200faChristian Maeder return $ Object n e as os
585094c4284ed39eb8024cc1178c823c403200faChristian Maeder
eb483f2216949400bfef8f6deb5320f071445626Christian MaederpProp' :: CharParser st RangedProp
e83ed59502a681713982f25c559aae77a4145734Christian MaederpProp' = choice $ map pRangedProp [Uni, Tot, Prop]
e64aab3e57d843884cd489cc3aa130120a400b05Christian Maeder
e953bea49e7f0e1a43bccf2a66c5e2a2b50848e0Christian MaederpSqlplug :: CharParser st [PatElem]
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaederpSqlplug = pKey "SQLPLUG" >> pObj >> return []
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaederpPhpplug :: CharParser st [PatElem]
eb483f2216949400bfef8f6deb5320f071445626Christian MaederpPhpplug = pKey "PHPPLUG" >> pObj >> return []
42c01284bba8d7c8d995c8dfb96ace57d28ed1bcTill Mossakowski
7e4157a70efe2acab30dbe5079bba6db90923785Christian MaederpExplain :: CharParser st [PatElem]
7e4157a70efe2acab30dbe5079bba6db90923785Christian MaederpExplain = do
7e4157a70efe2acab30dbe5079bba6db90923785Christian Maeder pKey "EXPLAIN"
7e4157a70efe2acab30dbe5079bba6db90923785Christian Maeder choice $ map pKey
7e4157a70efe2acab30dbe5079bba6db90923785Christian Maeder [ "CONCEPT", "RELATION", "RULE", "KEY", "SERVICE", "PATTERN"
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder , "POPULATION", "SQLPLUG", "PHPPLUG" ]
25a0b76bc87e80c0f697951d9817862755a71d33Christian Maeder pADLid
25a0b76bc87e80c0f697951d9817862755a71d33Christian Maeder pLanguageID
e83ed59502a681713982f25c559aae77a4145734Christian Maeder pRefID
c58a5efdb3c9fbc80deb1c69716f09c67292a41dChristian Maeder pExpl
25a0b76bc87e80c0f697951d9817862755a71d33Christian Maeder return []
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder
7e4157a70efe2acab30dbe5079bba6db90923785Christian MaederpLanguageID :: CharParser st String
7e4157a70efe2acab30dbe5079bba6db90923785Christian MaederpLanguageID = pKey "IN" >> (pKeyS "DUTCH" <|> pKeyS "ENGLISH")
7e4157a70efe2acab30dbe5079bba6db90923785Christian Maeder
7e4157a70efe2acab30dbe5079bba6db90923785Christian MaederpRefID :: CharParser st String
7e4157a70efe2acab30dbe5079bba6db90923785Christian MaederpRefID = optionL $ pKey "REF" >> pString
7e4157a70efe2acab30dbe5079bba6db90923785Christian Maeder
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaederpExpl :: CharParser st String
50dce6b011347f92377adb8bbabaeeb80975e86dChristian MaederpExpl = nestedComment "{+" "-}"
50dce6b011347f92377adb8bbabaeeb80975e86dChristian Maeder
e83ed59502a681713982f25c559aae77a4145734Christian MaederpContent :: Bool -> Relation -> CharParser st PatElem
7325bbe03797fd413af504fb3fac109b2c652a7bChristian MaederpContent b r = fmap (Population b r) $ pSqBrackets $ sepBy pRecord $ pSym ";"
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder
50dce6b011347f92377adb8bbabaeeb80975e86dChristian MaederpRecord :: CharParser st Pair
50dce6b011347f92377adb8bbabaeeb80975e86dChristian MaederpRecord = let ps = parseToken pString in
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder pParens $ liftM2 Pair ps $ pComma >> ps
c58a5efdb3c9fbc80deb1c69716f09c67292a41dChristian Maeder
50dce6b011347f92377adb8bbabaeeb80975e86dChristian MaederpRuleDef :: CharParser st PatElem
c58a5efdb3c9fbc80deb1c69716f09c67292a41dChristian MaederpRuleDef = do
c58a5efdb3c9fbc80deb1c69716f09c67292a41dChristian Maeder h <- option Always pSignalOrAlways
7325bbe03797fd413af504fb3fac109b2c652a7bChristian Maeder e1 <- pExpr
585094c4284ed39eb8024cc1178c823c403200faChristian Maeder r <- option (Truth e1) $ do
585094c4284ed39eb8024cc1178c823c403200faChristian Maeder sym <- choice $ map pSymS ["=", "|-", "-|"]
50dce6b011347f92377adb8bbabaeeb80975e86dChristian Maeder e2 <- pExpr
e83ed59502a681713982f25c559aae77a4145734Christian Maeder return $ Rule e1 (case sym of
50dce6b011347f92377adb8bbabaeeb80975e86dChristian Maeder "=" -> Equivalence
42c01284bba8d7c8d995c8dfb96ace57d28ed1bcTill Mossakowski "|-" -> Implication
50dce6b011347f92377adb8bbabaeeb80975e86dChristian Maeder "-|" -> ReverseImpl
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder _ -> error "pRuleDef") e2
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder option "" $ do
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder pKey "EXPLANATION"
e83ed59502a681713982f25c559aae77a4145734Christian Maeder pString
50dce6b011347f92377adb8bbabaeeb80975e86dChristian Maeder return $ Pr h r
7e4157a70efe2acab30dbe5079bba6db90923785Christian Maeder
e3c9174a782e90f965a0b080c22861c3ef5af12dTill MossakowskipSignalOrAlways :: CharParser st RuleHeader
e5298e75aafb75fe522b24c0ff1919f581980335Christian MaederpSignalOrAlways =
e5298e75aafb75fe522b24c0ff1919f581980335Christian Maeder fmap (RuleHeader SignalOn) (pKey "SIGNAL" >> pADLid << pKey "ON")
e5298e75aafb75fe522b24c0ff1919f581980335Christian Maeder <|> (pKey "RULE" >> liftM2 (flip RuleHeader) pADLid
7fc5ecf094ed7ad8f6dd878e719ef95c0b2a5da0Christian Maeder (choice $ map (\ r -> pKey (showRuleKind r) >> return r)
e5298e75aafb75fe522b24c0ff1919f581980335Christian Maeder [Maintains, Signals]))
25a0b76bc87e80c0f697951d9817862755a71d33Christian Maeder
90bf4bf40789422552e566b73738ba5efae144c3Christian MaederpGen :: CharParser st PatElem
e5298e75aafb75fe522b24c0ff1919f581980335Christian MaederpGen = do
e3c9174a782e90f965a0b080c22861c3ef5af12dTill Mossakowski pKey "GEN"
e83ed59502a681713982f25c559aae77a4145734Christian Maeder c1 <- pConcept
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder pKey "ISA"
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder c2 <- pConcept
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder return $ Pg c1 c2
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder
9929f81562adecc8aafaefb14a0159afcf4a3351Christian MaederpTwo :: CharParser st (Concept, Concept)
1320edfb75af112d509a6ce0a4c02425da7fed4dChristian MaederpTwo = option (Anything, Anything)
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder $ pSqBrackets $ do
1320edfb75af112d509a6ce0a4c02425da7fed4dChristian Maeder c1 <- pConcept
1600a2e47d5ed599df94d20411f0767fb6d68587Christian Maeder c2 <- option c1 $ do
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder pSym "*"
eb483f2216949400bfef8f6deb5320f071445626Christian Maeder pConcept
9929f81562adecc8aafaefb14a0159afcf4a3351Christian Maeder return (c1, c2)
57c51f0673511217c416090de812b779612e7551Christian Maeder
pConcept :: CharParser st Concept
pConcept = fmap C . parseToken $ pConid <|> pString <|> pKeyS "ONE"
pMorphism :: CharParser st Relation
pMorphism = do
nm <- parseToken $ pKeyS "I" <|> pKeyS "V" <|> pVarid <|> (sQuoted << skip)
(c1, c2) <- pTwo
return $ Sgn nm c1 c2
pExpr :: CharParser st Expression
pExpr = pPrec Fu pFactorI "\\/"
pFactorI :: CharParser st Expression
pFactorI = pPrec Fi pFactor "/\\"
pFactor :: CharParser st Expression
pFactor = pPrec Fd pTermD "!"
pTermD :: CharParser st Expression
pTermD = pPrec Fc pTerm ";"
pPrec :: MulOp -> CharParser st Expression -> String
-> CharParser st Expression
pPrec f p s = do
es <- sepBy1 p $ pSym s
return $ case es of
[e] -> e
_ -> MulExp f es
pTerm :: CharParser st Expression
pTerm = do
ms <- many pMinus
e <- pParens pExpr <|> fmap Tm pMorphism
rs <- many $ choice $ map (pSymS . (: [])) "+*~"
let p = foldl (\ r c -> UnExp (case c of
"+" -> K1
"*" -> K0
"~" -> Co
_ -> error "pTerm post strings") r) e rs
return $ foldl (\ r _ -> UnExp Cp r) p ms