murder 1.2 → 1.3
raw patch · 2 files changed
+41/−24 lines, 2 filesdep ~AspectAGdep ~uu-parsinglib
Dependency ranges changed: AspectAG, uu-parsinglib
Files
- murder.cabal +4/−4
- src/Language/Grammars/Murder/UUParsing.hs +37/−20
murder.cabal view
@@ -1,10 +1,10 @@ name: murder -version: 1.2+version: 1.3 cabal-version: >= 1.2.3 license: LGPL license-file: COPYRIGHT maintainer: Marcos Viera <mviera@fing.edu.uy>-homepage: http://www.cs.uu.nl/wiki/Center/MurderForFree +homepage: http://www.cs.uu.nl/wiki/Center/CoCoCo synopsis: MUtually Recursive Definitions Explicitly Represented description: The murder library is an EDSL for grammar fragments as first-class values. It provides combinators to define and extend grammars, and produce compilers out of them. build-type: Simple@@ -13,8 +13,8 @@ copyright: Universiteit Utrecht extra-source-files: README, LICENSE-LGPL library- build-depends: base>=4 && <5, template-haskell>=2.4.0.1, TTTAS>=0.4.1, AspectAG>=0.3.5,- uulib>=0.9.12, uu-parsinglib >= 2.7.1, ListLike >= 3.1.0, containers>=0.3, HList>=0.2+ build-depends: base>=4 && <5, template-haskell>=2.4.0.1, TTTAS>=0.4.1, AspectAG>=0.3.6,+ uulib>=0.9.12, uu-parsinglib >= 2.7.3.4, ListLike >= 3.1.0, containers>=0.3, HList>=0.2 exposed-modules: Language.Grammars.Grammar, Language.Grammars.Murder, Language.Grammars.Murder.Derive,
src/Language/Grammars/Murder/UUParsing.hs view
@@ -6,6 +6,9 @@ import Text.ParserCombinators.UU.Utils import Text.ParserCombinators.UU.BasicInstances hiding (Parser,input,msgs) +import qualified Data.Set as Set+import Data.List (nub)+ import Language.Grammars.Grammar import Language.AbstractSyntax.TTTAS @@ -17,23 +20,30 @@ pChr :: Parser Char pChr = pAscii -pVar :: Parser String-pVar = ((:) <$> pLower <*> pList pIdChar `micro` 2) <* spaces +pVar' :: Parser String+pVar' = ((:) <$> pLower <*> pList pIdChar `micro` 2) -pCon :: Parser String-pCon = ((:) <$> pUpper <*> pList pIdChar `micro` 2) <* spaces+pVar :: Set.Set String -> Parser String+pVar kws = (addLength 0 (pVar' >>= \i -> if i `Set.member` kws then pToken ("_not_reserved") else return i)) <* pSpaces +pCon' :: Parser String+pCon' = ((:) <$> pUpper <*> pList pIdChar `micro` 2)++pCon :: Set.Set String -> Parser String+pCon kws = (addLength 0 (pCon' >>= \i -> if i `Set.member` kws then pToken ("_not_reserved") else return i)) <* pSpaces + pIdChar :: Parser Char pIdChar = pLower <|> pUpper <|> pDigit <|> pAnySym "='" pOp :: Parser String-pOp = (pList1 $ pAnySym ('|':"!#$%&*+./<=>?@\\^-~:") `micro` 2) <* spaces+pOp = (pList1 $ pAnySym ('|':"!#$%&*+./<=>?@\\^-~:") `micro` 2) <* pSpaces pTerm :: String -> Parser String-pTerm keyw = pToken keyw `micro` 1 <* spaces-spaces :: Parser String-spaces = pMunch (`elem` " \n")+pTerm keyw = pToken keyw `micro` 1 <* pSpaces +pSpaces' :: Parser String+pSpaces' = (:) <$> pAnySym " \r\n\t" <*> pSpaces+ lc2Pos :: LineCol -> Pos lc2Pos (LineCol l c) = Pos l (c+1) @@ -42,8 +52,12 @@ -- | The function 'compile' generates a parser out of a closed grammar compile :: Grammar a -> Parser a-compile (Grammar (start :: Ref a env) rules) - = id <$ spaces <*> (unC (lookupEnv start result))+compile = compileKws Set.empty++-- | The function 'compileKws' generates a parser out of a closed grammar, restricting the identifiers to not belong to the list of reserved words+compileKws :: Set.Set String -> Grammar a -> Parser a+compileKws kws (Grammar (start :: Ref a env) rules) + = id <$ pSpaces <*> (unC (lookupEnv start result)) where result = mapEnv (\ (PS ps) -> C (foldr1 (<|>) [ comp p | p <- ps]))@@ -55,14 +69,14 @@ comp (FlipStar x y) = comp x <**> comp y comp (Pure x) = pure x - comp (Sym (Term t)) = (DTerm . lc2Pos) <$> pPos <*> pTerm t+ comp (Sym (Term t)) = (DTerm . lc2Pos) <$> pPos <*> pTerm t <?> t comp (Sym (Nont n)) = unC (lookupEnv n result) - comp (Sym TermInt) = (DTerm . lc2Pos) <$> pPos <*> pInt- comp (Sym TermChar) = (DTerm . lc2Pos) <$> pPos <*> pChr- comp (Sym TermVarid) = (DTerm . lc2Pos) <$> pPos <*> pVar- comp (Sym TermConid) = (DTerm . lc2Pos) <$> pPos <*> pCon- comp (Sym TermOp) = (DTerm . lc2Pos) <$> pPos <*> pOp+ comp (Sym TermInt) = (DTerm . lc2Pos) <$> pPos <*> pInt <?> "number"+ comp (Sym TermChar) = (DTerm . lc2Pos) <$> pPos <*> pChr <?> "character"+ comp (Sym TermVarid) = (DTerm . lc2Pos) <$> pPos <*> (pVar kws) <?> "identifier"+ comp (Sym TermConid) = (DTerm . lc2Pos) <$> pPos <*> (pCon kws) <?> "constructor"+ comp (Sym TermOp) = (DTerm . lc2Pos) <$> pPos <*> pOp <?> "operator" mapEnv :: (forall a . f a s -> g a s) @@ -76,13 +90,16 @@ | Rep a [Error LineCol] deriving Show -expand '\t' = ' '-expand c = c+nuberror :: Error a -> Error a+nuberror (Inserted m p ms) = Inserted m p (nub ms)+nuberror (Deleted m p ms) = Deleted m p (nub ms) +nuberror (Replaced m1 m2 p ms) = Replaced m1 m2 p (nub ms) +nuberror (DeletedAtEnd s) = (DeletedAtEnd s) -- | The function 'parse' runs the parser for an input. parse :: Parser a -> String -> ParseResult a-parse p input = case UU.parse ( (,) <$> p <*> pEnd) (createStr (LineCol 1 1) (map expand input)) of+parse p input = case UU.parse ( (,) <$> p <*> pEnd) (createStr (LineCol 1 1) input) of (a,[] ) -> Ok a- (a,msgs) -> Rep a msgs+ (a,msgs) -> Rep a $ map nuberror msgs