Parse.hs revision 38ab6c9ed72bcc625457c013832d5f531feab62f
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski{- |
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskiModule : $Header$
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskiDescription : ADL syntax parser
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskiCopyright : (c) Stef Joosten, Christian Maeder DFKI GmbH 2010
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskiLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskiMaintainer : Christian.Maeder@dfki.de
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskiStability : provisional
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskiPortability : portable
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski-}
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowskimodule Main where
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowskiimport Common.Parsec
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowskiimport Common.DocUtils
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowskiimport Common.Doc hiding (space)
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowskiimport System.Environment
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowskiimport Text.ParserCombinators.Parsec
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowskiimport Haskell.Wrapper
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowskiimport Adl.As
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowskiimport Adl.Print ()
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowskikeywordstxt :: [String]
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowskikeywordstxt =
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski [ "CONTEXT", "ENDCONTEXT", "EXTENDS"
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski , "PATTERN", "ENDPATTERN"
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski , "SERVICE", "INITIAL", "SQLPLUG", "PHPPLUG"
c57bde4abc9029546fa396c4eccacf969e126b96Mihai Codescu , "POPULATION", "CONTAINS"
c57bde4abc9029546fa396c4eccacf969e126b96Mihai Codescu , "UNI", "INJ", "SUR", "TOT", "SYM", "ASY", "TRN", "RFX", "PROP", "ALWAYS"
c57bde4abc9029546fa396c4eccacf969e126b96Mihai Codescu , "RULE", "MAINTAINS", "SIGNALS", "SIGNAL", "ON"
c57bde4abc9029546fa396c4eccacf969e126b96Mihai Codescu , "RELATION", "CONCEPT", "KEY"
c57bde4abc9029546fa396c4eccacf969e126b96Mihai Codescu , "IMPORT", "GEN", "ISA", "I", "V", "S"
c57bde4abc9029546fa396c4eccacf969e126b96Mihai Codescu , "PRAGMA", "EXPLANATION", "EXPLAIN", "IN", "REF", "ENGLISH", "DUTCH"
c57bde4abc9029546fa396c4eccacf969e126b96Mihai Codescu , "ONE", "BIND", "TOPHP", "BINDING"
c57bde4abc9029546fa396c4eccacf969e126b96Mihai Codescu ]
c57bde4abc9029546fa396c4eccacf969e126b96Mihai Codescu
c57bde4abc9029546fa396c4eccacf969e126b96Mihai Codescuskip :: CharParser st ()
c57bde4abc9029546fa396c4eccacf969e126b96Mihai Codescuskip = skipMany $ forget space <|> forget (nestComment <|> lineComment)
c57bde4abc9029546fa396c4eccacf969e126b96Mihai Codescu
c57bde4abc9029546fa396c4eccacf969e126b96Mihai CodescupChar :: CharParser st Char
c57bde4abc9029546fa396c4eccacf969e126b96Mihai CodescupChar = alphaNum <|> oneOf "_'"
de55550f7d117195f127481d18ec2d5e8d2317ffMihai Codescu
de55550f7d117195f127481d18ec2d5e8d2317ffMihai CodescupKeyS :: String -> CharParser st String
de55550f7d117195f127481d18ec2d5e8d2317ffMihai CodescupKeyS s = try (string s << notFollowedBy pChar) << skip
de55550f7d117195f127481d18ec2d5e8d2317ffMihai Codescu
de55550f7d117195f127481d18ec2d5e8d2317ffMihai CodescupKey :: String -> CharParser st ()
de55550f7d117195f127481d18ec2d5e8d2317ffMihai CodescupKey = forget . pKeyS
de55550f7d117195f127481d18ec2d5e8d2317ffMihai Codescu
de55550f7d117195f127481d18ec2d5e8d2317ffMihai CodescupSymC :: String -> String -> CharParser st String
de55550f7d117195f127481d18ec2d5e8d2317ffMihai CodescupSymC s cs = try (string s << notFollowedBy (oneOf cs)) << skip
de55550f7d117195f127481d18ec2d5e8d2317ffMihai Codescu
de55550f7d117195f127481d18ec2d5e8d2317ffMihai Codescu-- do not parse a double colon
de55550f7d117195f127481d18ec2d5e8d2317ffMihai CodescupColon :: CharParser st String
de55550f7d117195f127481d18ec2d5e8d2317ffMihai CodescupColon = pSymC ":" ":"
de55550f7d117195f127481d18ec2d5e8d2317ffMihai Codescu
de55550f7d117195f127481d18ec2d5e8d2317ffMihai Codescu-- do not parse --, ->, or -|
de55550f7d117195f127481d18ec2d5e8d2317ffMihai CodescupMinus :: CharParser st String
de55550f7d117195f127481d18ec2d5e8d2317ffMihai CodescupMinus = pSymC "-" "->|"
de55550f7d117195f127481d18ec2d5e8d2317ffMihai Codescu
de55550f7d117195f127481d18ec2d5e8d2317ffMihai CodescupSymS :: String -> CharParser st String
de55550f7d117195f127481d18ec2d5e8d2317ffMihai CodescupSymS s = tryString s << skip
de55550f7d117195f127481d18ec2d5e8d2317ffMihai Codescu
de55550f7d117195f127481d18ec2d5e8d2317ffMihai CodescupSym :: String -> CharParser st ()
de55550f7d117195f127481d18ec2d5e8d2317ffMihai CodescupSym = forget . pSymS
de55550f7d117195f127481d18ec2d5e8d2317ffMihai Codescu
de55550f7d117195f127481d18ec2d5e8d2317ffMihai CodescupComma :: CharParser st ()
de55550f7d117195f127481d18ec2d5e8d2317ffMihai CodescupComma = pSym ","
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipEqual :: CharParser st ()
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipEqual = pSym "="
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipGenParens :: String -> String -> CharParser st a -> CharParser st a
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipGenParens o c p =
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski pSym o >> p << pSym c
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipParens :: CharParser st a -> CharParser st a
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipParens = pGenParens "(" ")"
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipSqBrackets :: CharParser st a -> CharParser st a
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipSqBrackets = pGenParens "[" "]"
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipConid :: CharParser st String
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipConid = reserved keywordstxt (upper <:> many pChar) << skip
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipVarid :: CharParser st String
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipVarid = (lower <:> many pChar) << skip
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipString :: CharParser st String
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipString = (stringLit <|> charLit) << skip
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipADLid :: CharParser st String
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipADLid = pConid <|> pVarid <|> pString
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipArchitecture :: CharParser st [PatElem]
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipArchitecture = flat $ many1 pContext
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipContext :: CharParser st [PatElem]
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipContext = do
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski pKey "CONTEXT"
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski pConid
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski option () $ do
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski pColon
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski pExpr
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski forget $ optionL $ do
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski pKey "BINDING"
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski sepBy1 pBind pComma
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski optionL $ do
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski pKey "EXTENDS"
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski sepBy1 pConid pComma
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski ps <- many pContextElement
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski pKey "ENDCONTEXT"
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski return $ concat ps
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipBind :: CharParser st String
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipBind = pKey "BIND" >> pDeclaration << pKey "TOPHP" >> (pConid <|> pString)
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipContextElement :: CharParser st [PatElem]
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipContextElement = pPattern
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski <|> fmap (: [])
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski (choice [pObjDef, pDeclaration, pConceptDef, pKeyDef, pExplain])
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski <|> fmap (const []) (pSqlplug <|> pPhpplug
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski <|> (pKey "POPULATION" >> pMorphism << pKey "CONTAINS" >> pContent))
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipPattern :: CharParser st [PatElem]
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipPattern = pKey "PATTERN" >> (pConid <|> pString)
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski >> many pPatElem
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski << pKey "ENDPATTERN"
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipPatElem :: CharParser st PatElem
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipPatElem = pDeclaration <|> fmap Pr pRuleDef
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski <|> pGen <|> fmap (const Ignored)
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski (pConceptDef <|> pKeyDef <|> pExplain)
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipDeclaration :: CharParser st PatElem
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipDeclaration = do
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski n <- try $ pVarid << pSym "::"
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski c1 <- pConcept
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski s <- pSymS "*" <|> pSymS "->"
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski let ps = if s == "->" then [Uni, Tot] else []
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski c2 <- pConcept
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski as <- optionL pProps
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski optionL pPragma
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski optionL $ do
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski pKey "EXPLANATION"
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski pString
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski option () $ do
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski pEqual
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski pContent
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski return ()
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski pSym "."
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski return $ Pm (ps ++ as) $ Sgn n c1 c2
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipProps :: CharParser st [Prop]
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipProps = pSqBrackets $
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski sepBy (choice $ map (\ p -> pKey (showProp p) >> return p) allProps) pComma
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipPragma :: CharParser st [String]
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipPragma = pKey "PRAGMA" >> many1 pString
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipConceptDef :: CharParser st PatElem
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipConceptDef = do
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski pKey "CONCEPT"
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski pConcept
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski pString
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski optionL pString
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski return Ignored
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipKeyDef :: CharParser st PatElem
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipKeyDef = do
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski pKey "KEY"
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski pLabelProps
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski pConcept
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski pParens $ sepBy1 pKeyAtt pComma
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski return Ignored
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipLabelProps :: CharParser st String
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipLabelProps = do
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski n <- pADLid
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski optionL $ pGenParens "{" "}" $ sepBy1 pADLid pComma
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski pColon
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski return n
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipKeyAtt :: CharParser st Expression
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipKeyAtt = do
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski optionMaybe $ try pLabelProps
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski pExpr
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipObjDef :: CharParser st PatElem
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipObjDef = pKey "SERVICE" >> fmap Service pObj
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipObj :: CharParser st Object
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipObj = do
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski n <- pLabelProps
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski e <- pExpr
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski as <- optionL (pKey "ALWAYS" >> many pProp')
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski os <- optionL (pEqual >> pSqBrackets (sepBy pObj pComma))
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski return $ Object n e as os
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipProp' :: CharParser st Prop
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipProp' = choice $ map (\ p -> pKey (showProp p) >> return p) [Uni, Tot, Prop]
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipSqlplug :: CharParser st PatElem
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipSqlplug = pKey "SQLPLUG" >> pObj >> return Ignored
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipPhpplug :: CharParser st PatElem
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipPhpplug = pKey "PHPPLUG" >> pObj >> return Ignored
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipExplain :: CharParser st PatElem
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipExplain = do
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski pKey "EXPLAIN"
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski choice $ map pKey
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski [ "CONCEPT", "RELATION", "RULE", "KEY", "SERVICE", "PATTERN"
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski , "POPULATION", "SQLPLUG", "PHPPLUG" ]
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski pADLid
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski pLanguageID
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski pRefID
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski pExpl
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski return Ignored
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipLanguageID :: CharParser st String
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipLanguageID = pKey "IN" >> (pKeyS "DUTCH" <|> pKeyS "ENGLISH")
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipRefID :: CharParser st String
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipRefID = optionL $ pKey "REF" >> pString
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipExpl :: CharParser st String
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipExpl = nestedComment "{+" "-}"
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipContent :: CharParser st PatElem
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipContent = pSqBrackets (sepBy pRecord $ pSym ";") >> return Ignored
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipRecord :: CharParser st (String, String)
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipRecord = pParens $ pair pString $ pComma >> pString
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipRuleDef :: CharParser st Rule
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipRuleDef = do
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski option "" pSignalOrAlways
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski e1 <- pExpr
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski r <- option (Truth e1) $ do
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski sym <- choice $ map pSymS ["=", "|-", "-|"]
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski e2 <- pExpr
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski return $ Rule e1 (case sym of
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski "=" -> Equivalence
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski "|-" -> Implication
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski "-|" -> ReverseImpl
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski _ -> error "pRuleDef") e2
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski option "" $ do
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski pKey "EXPLANATION"
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski pString
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski return r
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipSignalOrAlways :: CharParser st String
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipSignalOrAlways =
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski (pKey "SIGNAL" >> pADLid << pKey "ON")
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski <|> (pKey "RULE" >> pADLid << (pKey "MAINTAINS" <|> pKey "SIGNALS"))
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipGen :: CharParser st PatElem
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipGen = do
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski pKey "GEN"
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski c1 <- pConcept
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski pKey "ISA"
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski c2 <- pConcept
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski return $ Pg c1 c2
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipTwo :: CharParser st (Concept, Concept)
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipTwo = option (Anything, Anything)
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski $ pSqBrackets $ do
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski c1 <- pConcept
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski c2 <- option c1 $ do
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski pSym "*"
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski pConcept
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski return (c1, c2)
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipConcept :: CharParser st Concept
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipConcept = fmap C $ pConid <|> pString <|> pKeyS "ONE"
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipMorphism :: CharParser st Expression
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipMorphism = do
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski nm <- pKeyS "I" <|> pKeyS "V" <|> pVarid <|> (charLit << skip)
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski (c1, c2) <- pTwo
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski return $ Tm $ Sgn nm c1 c2
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipExpr :: CharParser st Expression
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipExpr = pPrec Fu pFactorI "\\/"
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipFactorI :: CharParser st Expression
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipFactorI = pPrec Fi pFactor "/\\"
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipFactor :: CharParser st Expression
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipFactor = pPrec Fd pTermD "!"
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipTermD :: CharParser st Expression
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipTermD = pPrec Fc pTerm ";"
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipPrec :: MulOp -> CharParser st Expression -> String
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski -> CharParser st Expression
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipPrec f p s = do
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski es <- sepBy1 p $ pSym s
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski return $ case es of
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski [e] -> e
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski _ -> MulExp f es
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipTerm :: CharParser st Expression
d3f2015ae170a15e5b57d4880ded53073d725ac0Till MossakowskipTerm = do
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski ms <- many $ pMinus
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski e <- pParens pExpr <|> pMorphism
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski rs <- many $ choice $ map (pSymS . (: [])) "+*~"
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski let p = foldl (\ r c -> UnExp (case c of
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski "+" -> K1
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski "*" -> K0
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski "~" -> Co
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski _ -> error "pTerm post strings") r) e rs
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski return $ foldl (\ r _ -> UnExp Cp r) p ms
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowskimain :: IO ()
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowskimain = getArgs >>= mapM_ process
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowskiprocess :: String -> IO ()
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowskiprocess f = do
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski s <- readFile f
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski case parse (skip >> pArchitecture << eof) f s of
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski Right es -> print $ vcat $ map pretty es
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski Left err -> fail $ show err
d3f2015ae170a15e5b57d4880ded53073d725ac0Till Mossakowski