Parse.hs revision f30760456a3b6f7d4d54c65323dbc73cceca68fb
53bd0c89aa4743dc41a6394db5a90717c1ca4517Liam O'ReillyModule : $Header$
53bd0c89aa4743dc41a6394db5a90717c1ca4517Liam O'ReillyDescription : ADL syntax parser
53bd0c89aa4743dc41a6394db5a90717c1ca4517Liam O'ReillyCopyright : (c) Stef Joosten, Christian Maeder DFKI GmbH 2010
53bd0c89aa4743dc41a6394db5a90717c1ca4517Liam O'ReillyLicense : GPLv2 or higher
53bd0c89aa4743dc41a6394db5a90717c1ca4517Liam O'ReillyMaintainer : Christian.Maeder@dfki.de
53bd0c89aa4743dc41a6394db5a90717c1ca4517Liam O'ReillyStability : provisional
53bd0c89aa4743dc41a6394db5a90717c1ca4517Liam O'ReillyPortability : portable
66bc8d6e69cde43f1ccbeb76104cf7b8038acd6cChristian Maederimport Common.Lexer (parseToken)
e90dc723887d541f809007ae81c9bb73ced9592eChristian Maederimport Common.Token (criticalKeywords)
66bc8d6e69cde43f1ccbeb76104cf7b8038acd6cChristian Maederkeywordstxt :: [String]
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly [ "CONTEXT", "ENDCONTEXT", "EXTENDS"
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly , "PATTERN", "ENDPATTERN"
53bd0c89aa4743dc41a6394db5a90717c1ca4517Liam O'Reilly , "SERVICE", "INITIAL", "SQLPLUG", "PHPPLUG"
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder , "POPULATION", "CONTAINS"
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder , "UNI", "INJ", "SUR", "TOT", "SYM", "ASY", "TRN", "RFX", "PROP", "ALWAYS"
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian Maeder , "RULE", "MAINTAINS", "SIGNALS", "SIGNAL", "ON"
f21c7417bdd1c0282025cba0f5cb0ff5bc5c98eeLiam O'Reilly , "RELATION", "CONCEPT", "KEY"
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder , "IMPORT", "GEN", "ISA", "I", "V", "S"
d5833d2ee7bafcbf2fdd2bdfd9a728c769b100c7Christian Maeder , "PRAGMA", "EXPLANATION", "EXPLAIN", "IN", "REF", "ENGLISH", "DUTCH"
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly , "ONE", "BIND", "TOPHP", "BINDING"
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly-- | a line comment starts with --. In haskell this may be part of an operator.
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian MaederlineComment :: CharParser st String
33bdce26495121cdbce30331ef90a1969126a840Liam O'ReillylineComment = tryString "--" <++> many (noneOf "\n")
036ecbd8f721096321f47cf6a354a9d1bf3d032fChristian Maederskip :: CharParser st ()
fa373bc327620e08861294716b4454be8d25669fChristian Maederskip = skipMany $ forget space
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian Maeder <|> forget (nestedComment "{-" "-}" <|> lineComment)
53bd0c89aa4743dc41a6394db5a90717c1ca4517Liam O'ReillypChar :: CharParser st Char
53bd0c89aa4743dc41a6394db5a90717c1ca4517Liam O'ReillypChar = alphaNum <|> oneOf "_'"
53bd0c89aa4743dc41a6394db5a90717c1ca4517Liam O'ReillypKeyS :: String -> CharParser st String
33bdce26495121cdbce30331ef90a1969126a840Liam O'ReillypKeyS s = try (string s << notFollowedBy pChar) << skip
648fe1220044aac847acbdfbc4155af5556063ebChristian MaederpKey :: String -> CharParser st ()
648fe1220044aac847acbdfbc4155af5556063ebChristian MaederpKey = forget . pKeyS
648fe1220044aac847acbdfbc4155af5556063ebChristian MaederpSymC :: String -> String -> CharParser st String
648fe1220044aac847acbdfbc4155af5556063ebChristian MaederpSymC s cs = try (string s << notFollowedBy (oneOf cs)) << skip
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder-- do not parse a double colon
648fe1220044aac847acbdfbc4155af5556063ebChristian MaederpColon :: CharParser st String
648fe1220044aac847acbdfbc4155af5556063ebChristian MaederpColon = pSymC ":" ":"
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder-- do not parse --, ->, or -|
648fe1220044aac847acbdfbc4155af5556063ebChristian MaederpMinus :: CharParser st String
4314e26a12954cb1c9be4dea10aa8103edac5bbbChristian MaederpMinus = pSymC "-" "->|"
d5833d2ee7bafcbf2fdd2bdfd9a728c769b100c7Christian MaederpSymS :: String -> CharParser st String
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'ReillypSymS s = tryString s << skip
33bdce26495121cdbce30331ef90a1969126a840Liam O'ReillypSym :: String -> CharParser st ()
648fe1220044aac847acbdfbc4155af5556063ebChristian MaederpSym = forget . pSymS
648fe1220044aac847acbdfbc4155af5556063ebChristian MaederpComma :: CharParser st ()
648fe1220044aac847acbdfbc4155af5556063ebChristian MaederpComma = pSym ","
648fe1220044aac847acbdfbc4155af5556063ebChristian MaederpEqual :: CharParser st ()
33bdce26495121cdbce30331ef90a1969126a840Liam O'ReillypEqual = pSym "="
fa373bc327620e08861294716b4454be8d25669fChristian MaederpGenParens :: String -> String -> CharParser st a -> CharParser st a
fa373bc327620e08861294716b4454be8d25669fChristian MaederpGenParens o c p =
fa373bc327620e08861294716b4454be8d25669fChristian Maeder pSym o >> p << pSym c
fa373bc327620e08861294716b4454be8d25669fChristian MaederpParens :: CharParser st a -> CharParser st a
fa373bc327620e08861294716b4454be8d25669fChristian MaederpParens = pGenParens "(" ")"
fa373bc327620e08861294716b4454be8d25669fChristian MaederpSqBrackets :: CharParser st a -> CharParser st a
fa373bc327620e08861294716b4454be8d25669fChristian MaederpSqBrackets = pGenParens "[" "]"
fa373bc327620e08861294716b4454be8d25669fChristian MaederpConid :: CharParser st String
648fe1220044aac847acbdfbc4155af5556063ebChristian MaederpConid = reserved keywordstxt (upper <:> many pChar) << skip
d5833d2ee7bafcbf2fdd2bdfd9a728c769b100c7Christian MaederpVarid :: CharParser st String
7857a35e3af533dfbd0f0e18638ebd211e6358a0Christian MaederpVarid = reserved criticalKeywords
7857a35e3af533dfbd0f0e18638ebd211e6358a0Christian Maeder ((lower <|> char '_') <:> many pChar) << skip
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'ReillypString :: CharParser st String
648fe1220044aac847acbdfbc4155af5556063ebChristian MaederpString = (stringLit <|> sQuoted) << skip
7857a35e3af533dfbd0f0e18638ebd211e6358a0Christian MaederpADLid :: CharParser st Token
648fe1220044aac847acbdfbc4155af5556063ebChristian MaederpADLid = parseToken $ pConid <|> pVarid <|> pString
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder-- | parse contexts but do not require CONTEXT blocks
648fe1220044aac847acbdfbc4155af5556063ebChristian MaederpArchitecture :: CharParser st Context
648fe1220044aac847acbdfbc4155af5556063ebChristian MaederpArchitecture = pContext
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder <|> fmap (Context Nothing) (flat $ many1 pContextElement)
648fe1220044aac847acbdfbc4155af5556063ebChristian MaederpContext :: CharParser st Context
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder pKey "CONTEXT"
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder c <- parseToken pConid
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder option () $ do
eb48217dfa67ddb87b8fbd846de293d0636bd578Christian Maeder forget $ optionL $ do
eb48217dfa67ddb87b8fbd846de293d0636bd578Christian Maeder pKey "BINDING"
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian Maeder sepBy1 pBind pComma
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian Maeder pKey "EXTENDS"
eb48217dfa67ddb87b8fbd846de293d0636bd578Christian Maeder sepBy1 pConid pComma
eb48217dfa67ddb87b8fbd846de293d0636bd578Christian Maeder ps <- many pContextElement
eb48217dfa67ddb87b8fbd846de293d0636bd578Christian Maeder pKey "ENDCONTEXT"
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian Maeder return $ Context (Just c) $ concat ps
648fe1220044aac847acbdfbc4155af5556063ebChristian MaederpBind :: CharParser st String
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian MaederpBind = pKey "BIND" >> pDeclaration << pKey "TOPHP" >> (pConid <|> pString)
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder-- | parse a context element but do not require the PATTERN block
4314e26a12954cb1c9be4dea10aa8103edac5bbbChristian MaederpContextElement :: CharParser st [PatElem]
648fe1220044aac847acbdfbc4155af5556063ebChristian MaederpContextElement = pPattern <|> flat (many1 pPatElem)
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder <|> single (pObjDef <|> pPopulation)
648fe1220044aac847acbdfbc4155af5556063ebChristian MaederpPopulation :: CharParser st PatElem
648fe1220044aac847acbdfbc4155af5556063ebChristian MaederpPopulation = do
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder pKey "POPULATION"
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder r <- pMorphism
4314e26a12954cb1c9be4dea10aa8103edac5bbbChristian Maeder pKey "CONTAINS"
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder pContent False r
648fe1220044aac847acbdfbc4155af5556063ebChristian MaederpPattern :: CharParser st [PatElem]
33bdce26495121cdbce30331ef90a1969126a840Liam O'ReillypPattern = pKey "PATTERN" >> (pConid <|> pString)
d5833d2ee7bafcbf2fdd2bdfd9a728c769b100c7Christian Maeder >> flat (many pPatElem)
d5833d2ee7bafcbf2fdd2bdfd9a728c769b100c7Christian Maeder << pKey "ENDPATTERN"
648fe1220044aac847acbdfbc4155af5556063ebChristian MaederpPatElem :: CharParser st [PatElem]
648fe1220044aac847acbdfbc4155af5556063ebChristian MaederpPatElem = pDeclaration <|> pConceptDef <|> pExplain
e0f1794e365dd347e97b37d7d22b2fce27296fa1Christian Maeder <|> single (pRuleDef <|> pGen <|> pKeyDef)
648fe1220044aac847acbdfbc4155af5556063ebChristian MaederpDeclaration :: CharParser st [PatElem]
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian MaederpDeclaration = do
7857a35e3af533dfbd0f0e18638ebd211e6358a0Christian Maeder n <- try $ parseToken pVarid << pSym "::"
7857a35e3af533dfbd0f0e18638ebd211e6358a0Christian Maeder c1 <- pConcept
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian Maeder s <- parseToken $ pSymS "*" <|> pSymS "->"
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder let ps = if tokStr s == "->" then
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian Maeder map (flip RangedProp $ tokPos s) [Uni, Tot] else []
7857a35e3af533dfbd0f0e18638ebd211e6358a0Christian Maeder c2 <- pConcept
7857a35e3af533dfbd0f0e18638ebd211e6358a0Christian Maeder as <- optionL pProps
7857a35e3af533dfbd0f0e18638ebd211e6358a0Christian Maeder optionL pPragma
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder pKey "EXPLANATION"
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder let r = Sgn n c1 c2
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder p <- optionL $ do
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder single $ pContent True r
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder return $ Pm (ps ++ as) r (not $ null p) : p
bcd914850de931848b86d7728192a149f9c0108bChristian MaederpRangedProp :: Prop -> CharParser st RangedProp
33bdce26495121cdbce30331ef90a1969126a840Liam O'ReillypRangedProp p = liftM2 (flip RangedProp)
7d96b1ef2b8597330aedee6713615ec15508edcfLiam O'Reilly (liftM tokPos $ parseToken $ pKeyS $ showUp p) $ return p
935613eb8e67d724f1c4a4d4a37be3324ef6708dChristian MaederpProps :: CharParser st [RangedProp]
f21c7417bdd1c0282025cba0f5cb0ff5bc5c98eeLiam O'ReillypProps = pSqBrackets $ sepBy
f21c7417bdd1c0282025cba0f5cb0ff5bc5c98eeLiam O'Reilly (choice $ map pRangedProp allProps) pComma
f21c7417bdd1c0282025cba0f5cb0ff5bc5c98eeLiam O'ReillypPragma :: CharParser st [String]
f19dc06364e8d6ea36f7c170e1f7a0677de63184Liam O'ReillypPragma = pKey "PRAGMA" >> many1 pString
f21c7417bdd1c0282025cba0f5cb0ff5bc5c98eeLiam O'ReillypConceptDef :: CharParser st [PatElem]
f21c7417bdd1c0282025cba0f5cb0ff5bc5c98eeLiam O'ReillypConceptDef = do
f19dc06364e8d6ea36f7c170e1f7a0677de63184Liam O'Reilly pKey "CONCEPT"
f19dc06364e8d6ea36f7c170e1f7a0677de63184Liam O'Reilly optionL pString
7d96b1ef2b8597330aedee6713615ec15508edcfLiam O'ReillypKeyDef :: CharParser st PatElem
7d96b1ef2b8597330aedee6713615ec15508edcfLiam O'Reilly t <- pLabelProps
935613eb8e67d724f1c4a4d4a37be3324ef6708dChristian Maeder c <- pConcept
7d96b1ef2b8597330aedee6713615ec15508edcfLiam O'Reilly l <- pParens $ sepBy1 pKeyAtt pComma
7d96b1ef2b8597330aedee6713615ec15508edcfLiam O'Reilly return $ Pk $ KeyDef t c l
7d96b1ef2b8597330aedee6713615ec15508edcfLiam O'ReillypLabelProps :: CharParser st Token
f19dc06364e8d6ea36f7c170e1f7a0677de63184Liam O'ReillypLabelProps = do
7d96b1ef2b8597330aedee6713615ec15508edcfLiam O'Reilly optionL $ pGenParens "{" "}" $ sepBy1 pADLid pComma
f19dc06364e8d6ea36f7c170e1f7a0677de63184Liam O'ReillypKeyAtt :: CharParser st KeyAtt
f19dc06364e8d6ea36f7c170e1f7a0677de63184Liam O'ReillypKeyAtt = liftM2 KeyAtt (optionMaybe $ try pLabelProps) pExpr
f19dc06364e8d6ea36f7c170e1f7a0677de63184Liam O'ReillypObjDef :: CharParser st PatElem
f19dc06364e8d6ea36f7c170e1f7a0677de63184Liam O'ReillypObjDef = liftM2 Plug
f19dc06364e8d6ea36f7c170e1f7a0677de63184Liam O'Reilly (choice $ map (\ p -> pKey (showUp p) >> return p)
f19dc06364e8d6ea36f7c170e1f7a0677de63184Liam O'Reilly [Service, Sqlplug, Phpplug]) pObj
f19dc06364e8d6ea36f7c170e1f7a0677de63184Liam O'ReillypObj :: CharParser st Object
f19dc06364e8d6ea36f7c170e1f7a0677de63184Liam O'Reilly n <- pLabelProps
7d96b1ef2b8597330aedee6713615ec15508edcfLiam O'Reilly as <- optionL (pKey "ALWAYS" >> many pProp')
7d96b1ef2b8597330aedee6713615ec15508edcfLiam O'Reilly os <- optionL (pEqual >> pSqBrackets (sepBy pObj pComma))
f19dc06364e8d6ea36f7c170e1f7a0677de63184Liam O'Reilly return $ Object n e as os
f19dc06364e8d6ea36f7c170e1f7a0677de63184Liam O'ReillypProp' :: CharParser st RangedProp
f19dc06364e8d6ea36f7c170e1f7a0677de63184Liam O'ReillypProp' = choice $ map pRangedProp [Uni, Tot, Prop]
f19dc06364e8d6ea36f7c170e1f7a0677de63184Liam O'ReillypExplain :: CharParser st [PatElem]
f19dc06364e8d6ea36f7c170e1f7a0677de63184Liam O'Reilly pKey "EXPLAIN"
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian Maeder choice $ map pKey
fa373bc327620e08861294716b4454be8d25669fChristian Maeder [ "CONCEPT", "RELATION", "RULE", "KEY", "SERVICE", "PATTERN"
fa373bc327620e08861294716b4454be8d25669fChristian Maeder , "POPULATION", "SQLPLUG", "PHPPLUG" ]
fa373bc327620e08861294716b4454be8d25669fChristian MaederpLanguageID :: CharParser st String
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian MaederpLanguageID = pKey "IN" >> (pKeyS "DUTCH" <|> pKeyS "ENGLISH")
fa373bc327620e08861294716b4454be8d25669fChristian MaederpRefID :: CharParser st String
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian MaederpRefID = optionL $ pKey "REF" >> pString
fa373bc327620e08861294716b4454be8d25669fChristian MaederpExpl :: CharParser st String
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian MaederpExpl = nestedComment "{+" "-}"
fa373bc327620e08861294716b4454be8d25669fChristian MaederpContent :: Bool -> Relation -> CharParser st PatElem
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian MaederpContent b r = fmap (Population b r) $ pSqBrackets $ sepBy pRecord $ pSym ";"
fa373bc327620e08861294716b4454be8d25669fChristian MaederpRecord :: CharParser st Pair
fa373bc327620e08861294716b4454be8d25669fChristian MaederpRecord = let ps = parseToken pString in
fa373bc327620e08861294716b4454be8d25669fChristian Maeder pParens $ liftM2 Pair ps $ pComma >> ps
fa373bc327620e08861294716b4454be8d25669fChristian MaederpRuleDef :: CharParser st PatElem
fa373bc327620e08861294716b4454be8d25669fChristian Maeder h <- option Always pSignalOrAlways
fa373bc327620e08861294716b4454be8d25669fChristian Maeder r <- option (Truth e1) $ do
fa373bc327620e08861294716b4454be8d25669fChristian Maeder sym <- choice $ map pSymS ["=", "|-", "-|"]
fa373bc327620e08861294716b4454be8d25669fChristian Maeder return $ Rule e1 (case sym of
fa373bc327620e08861294716b4454be8d25669fChristian Maeder "=" -> Equivalence
fa373bc327620e08861294716b4454be8d25669fChristian Maeder "|-" -> Implication
fa373bc327620e08861294716b4454be8d25669fChristian Maeder "-|" -> ReverseImpl
fa373bc327620e08861294716b4454be8d25669fChristian Maeder _ -> error "pRuleDef") e2
fa373bc327620e08861294716b4454be8d25669fChristian Maeder option "" $ do
fa373bc327620e08861294716b4454be8d25669fChristian Maeder pKey "EXPLANATION"
fa373bc327620e08861294716b4454be8d25669fChristian Maeder return $ Pr h r
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian MaederpSignalOrAlways :: CharParser st RuleHeader
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian MaederpSignalOrAlways =
fa373bc327620e08861294716b4454be8d25669fChristian Maeder fmap (RuleHeader SignalOn) (pKey "SIGNAL" >> pADLid << pKey "ON")
fa373bc327620e08861294716b4454be8d25669fChristian Maeder <|> (pKey "RULE" >> liftM2 (flip RuleHeader) pADLid
fa373bc327620e08861294716b4454be8d25669fChristian Maeder (choice $ map (\ r -> pKey (showRuleKind r) >> return r)
fa373bc327620e08861294716b4454be8d25669fChristian Maeder [Maintains, Signals]))
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian MaederpGen :: CharParser st PatElem
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian Maeder c1 <- pConcept
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian Maeder c2 <- pConcept
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian Maeder return $ Pg c1 c2
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian MaederpTwo :: CharParser st (Concept, Concept)
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian MaederpTwo = option (Anything, Anything)
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian Maeder $ pSqBrackets $ do
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian Maeder c1 <- pConcept
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian Maeder c2 <- option c1 $ do
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian Maeder return (c1, c2)
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian MaederpConcept :: CharParser st Concept
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian MaederpConcept = fmap C . parseToken $ pConid <|> pString <|> pKeyS "ONE"
33bdce26495121cdbce30331ef90a1969126a840Liam O'ReillypMorphism :: CharParser st Relation
66bc8d6e69cde43f1ccbeb76104cf7b8038acd6cChristian MaederpMorphism = do
66bc8d6e69cde43f1ccbeb76104cf7b8038acd6cChristian Maeder nm <- parseToken $ pKeyS "I" <|> pKeyS "V" <|> pVarid <|> (sQuoted << skip)
66bc8d6e69cde43f1ccbeb76104cf7b8038acd6cChristian Maeder (c1, c2) <- pTwo
66bc8d6e69cde43f1ccbeb76104cf7b8038acd6cChristian Maeder return $ Sgn nm c1 c2
66bc8d6e69cde43f1ccbeb76104cf7b8038acd6cChristian MaederpExpr :: CharParser st Expression
66bc8d6e69cde43f1ccbeb76104cf7b8038acd6cChristian MaederpExpr = pPrec Fu pFactorI "\\/"
ace03c3051e5c5144e43ae78cae73f6a29dde6d5Christian MaederpFactorI :: CharParser st Expression
ace03c3051e5c5144e43ae78cae73f6a29dde6d5Christian MaederpFactorI = pPrec Fi pFactor "/\\"
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian MaederpFactor :: CharParser st Expression
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian MaederpFactor = pPrec Fd pTermD "!"
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian MaederpTermD :: CharParser st Expression
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian MaederpTermD = pPrec Fc pTerm ";"
33bdce26495121cdbce30331ef90a1969126a840Liam O'ReillypPrec :: MulOp -> CharParser st Expression -> String
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly -> CharParser st Expression
33bdce26495121cdbce30331ef90a1969126a840Liam O'ReillypPrec f p s = do
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly es <- sepBy1 p $ pSym s
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder return $ case es of
8e9c3881fb6e710b1e08bf5ac8ff9d393df2e74eChristian Maeder _ -> MulExp f es
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian MaederpTerm :: CharParser st Expression
935613eb8e67d724f1c4a4d4a37be3324ef6708dChristian Maeder ms <- many pMinus
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly e <- pParens pExpr <|> fmap Tm pMorphism
a00461fcf7432205a79a0f12dbe6c1ebc58bc000Christian Maeder rs <- many $ choice $ map (pSymS . (: [])) "+*~"
a00461fcf7432205a79a0f12dbe6c1ebc58bc000Christian Maeder let p = foldl (\ r c -> UnExp (case c of
a00461fcf7432205a79a0f12dbe6c1ebc58bc000Christian Maeder _ -> error "pTerm post strings") r) e rs
2a5b885d9350ec6dd8bc4992ee91d2f68aa592f4Christian Maeder return $ foldl (\ r _ -> UnExp Cp r) p ms