diff options
| author | aarne <aarne@cs.chalmers.se> | 2008-06-25 16:43:48 +0000 |
|---|---|---|
| committer | aarne <aarne@cs.chalmers.se> | 2008-06-25 16:43:48 +0000 |
| commit | b96b36f43de3e2f8b58d5f539daa6f6d47f25870 (patch) | |
| tree | 0992334be13cec6538a1dea22fbbf26ad6bdf224 /src/GF/GFCC/Raw/ParGFCCRaw.hs | |
| parent | fe367412e0aeb4ad5c02de68e6eca382e0f96984 (diff) | |
removed src for 2.9
Diffstat (limited to 'src/GF/GFCC/Raw/ParGFCCRaw.hs')
| -rw-r--r-- | src/GF/GFCC/Raw/ParGFCCRaw.hs | 99 |
1 files changed, 0 insertions, 99 deletions
diff --git a/src/GF/GFCC/Raw/ParGFCCRaw.hs b/src/GF/GFCC/Raw/ParGFCCRaw.hs deleted file mode 100644 index b71904948..000000000 --- a/src/GF/GFCC/Raw/ParGFCCRaw.hs +++ /dev/null @@ -1,99 +0,0 @@ -module GF.GFCC.Raw.ParGFCCRaw (parseGrammar) where - -import GF.GFCC.Raw.AbsGFCCRaw - -import Control.Monad -import Data.Char - -parseGrammar :: String -> IO Grammar -parseGrammar s = case runP pGrammar s of - Just (x,"") -> return x - _ -> fail "Parse error" - -pGrammar :: P Grammar -pGrammar = liftM Grm pTerms - -pTerms :: P [RExp] -pTerms = liftM2 (:) (pTerm 1) pTerms <++ (skipSpaces >> return []) - -pTerm :: Int -> P RExp -pTerm n = skipSpaces >> (pParen <++ pApp <++ pNum <++ pStr <++ pMeta) - where pParen = between (char '(') (char ')') (pTerm 0) - pApp = liftM2 App pIdent (if n == 0 then pTerms else return []) - pStr = char '"' >> liftM AStr (manyTill (pEsc <++ get) (char '"')) - pEsc = char '\\' >> get - pNum = do x <- munch1 isDigit - ((char '.' >> munch1 isDigit >>= \y -> return (AFlt (read (x++"."++y)))) - <++ - return (AInt (read x))) - pMeta = char '?' >> return AMet - pIdent = liftM CId $ liftM2 (:) (satisfy isIdentFirst) (munch isIdentRest) - isIdentFirst c = c == '_' || isAlpha c - isIdentRest c = c == '_' || c == '\'' || isAlphaNum c - --- Parser combinators with only left-biased choice - -newtype P a = P { runP :: String -> Maybe (a,String) } - -instance Monad P where - return x = P (\ts -> Just (x,ts)) - P p >>= f = P (\ts -> p ts >>= \ (x,ts') -> runP (f x) ts') - fail _ = pfail - -instance MonadPlus P where - mzero = pfail - mplus = (<++) - - -get :: P Char -get = P (\ts -> case ts of - [] -> Nothing - c:cs -> Just (c,cs)) - -look :: P String -look = P (\ts -> Just (ts,ts)) - -(<++) :: P a -> P a -> P a -P p <++ P q = P (\ts -> p ts `mplus` q ts) - -pfail :: P a -pfail = P (\ts -> Nothing) - -satisfy :: (Char -> Bool) -> P Char -satisfy p = do c <- get - if p c then return c else pfail - -char :: Char -> P Char -char c = satisfy (c==) - -string :: String -> P String -string this = look >>= scan this - where - scan [] _ = return this - scan (x:xs) (y:ys) | x == y = get >> scan xs ys - scan _ _ = pfail - -skipSpaces :: P () -skipSpaces = look >>= skip - where - skip (c:s) | isSpace c = get >> skip s - skip _ = return () - -manyTill :: P a -> P end -> P [a] -manyTill p end = scan - where scan = (end >> return []) <++ liftM2 (:) p scan - -munch :: (Char -> Bool) -> P String -munch p = munch1 p <++ return [] - -munch1 :: (Char -> Bool) -> P String -munch1 p = liftM2 (:) (satisfy p) (munch p) - -choice :: [P a] -> P a -choice = msum - -between :: P open -> P close -> P a -> P a -between open close p = do open - x <- p - close - return x |
