| Line No. | Rev | Author | Line |
|---|---|---|---|
| 1 | 24 | paulosilva | |
| 2 | {-# LANGUAGE FlexibleContexts #-} | ||
| 3 | {-# OPTIONS_GHC -Wall #-} | ||
| 4 | |||
| 5 | ------------------------------------------------------------------------------- | ||
| 6 | |||
| 7 | {- | | ||
| 8 | Module : Language.R.Parser | ||
| 9 | Description : Parser of the fork representation. | ||
| 10 | Copyright : (c) Paulo Silva | ||
| 11 | License : LGPL | ||
| 12 | |||
| 13 | Maintainer : paufil@di.uminho.pt | ||
| 14 | Stability : experimental | ||
| 15 | Portability : portable | ||
| 16 | |||
| 17 | -} | ||
| 18 | |||
| 19 | ------------------------------------------------------------------------------- | ||
| 20 | |||
| 21 | module Language.Fork.Parser ( | ||
| 22 | parser, | ||
| 23 | parseFork | ||
| 24 | ) where | ||
| 25 | |||
| 26 | import Control.GalcError | ||
| 27 | import Control.Monad.Error | ||
| 28 | import Language.R.SyntaxADT | ||
| 29 | import qualified Language.Type.Parser as T | ||
| 30 | import Text.ParserCombinators.Parsec | ||
| 31 | import Text.ParserCombinators.Parsec.Language | ||
| 32 | import qualified Text.ParserCombinators.Parsec.Token as P | ||
| 33 | import Text.ParserCombinators.Parsec.Expr | ||
| 34 | import Text.ParserCombinators.Parsec.Utils | ||
| 35 | |||
| 36 | ------------------------------------------------------------------------------- | ||
| 37 | |||
| 38 | parser :: MonadError GalcError m => String -> m S | ||
| 39 | parser = either2error (ParsingError . show) . parse (wrapper lexer parseFork) "" | ||
| 40 | |||
| 41 | parseFork :: Parser S | ||
| 42 | parseFork = buildExpressionParser table term | ||
| 43 | <?> "Fork expression" | ||
| 44 | |||
| 45 | term :: Parser S | ||
| 46 | term = | ||
| 47 | P.parens lexer parseFork <|> | ||
| 48 | parseIdentifierP lexer RefS <|> | ||
| 49 | parseVariableP lexer VarS <|> | ||
| 50 | parseKeywordP lexer "Id" IdS <|> | ||
| 51 | parseKeywordP lexer "Top" TopS <|> | ||
| 52 | parseKeywordP lexer "Bot" BotS <?> | ||
| 53 | "Fork simple expression" | ||
| 54 | |||
| 55 | table :: Table S | ||
| 56 | table = [ | ||
| 57 | [postfixP lexer "*" ConvS], | ||
| 58 | [prefixP lexer "~" NegS], | ||
| 59 | [binaryP lexer "/*\\" SplitS AssocLeft], | ||
| 60 | [binaryP lexer "/\\" MeetS AssocLeft, binaryP lexer "\\/" JoinS AssocLeft], | ||
| 61 | [binaryP lexer "." CompS AssocLeft] | ||
| 62 | ] | ||
| 63 | |||
| 64 | reservedNames' :: [String] | ||
| 65 | reservedNames' = ["Id", "Top", "Bot"] | ||
| 66 | |||
| 67 | reservedOpNames' :: [String] | ||
| 68 | reservedOpNames' = ["*", "~", "/*\\", "/\\", "\\/", "."] | ||
| 69 | |||
| 70 | lexer :: P.TokenParser st | ||
| 71 | lexer = P.makeTokenParser $ | ||
| 72 | emptyDef { P.reservedNames = reservedNames', | ||
| 73 | P.reservedOpNames = reservedOpNames', | ||
| 74 | P.identStart = lower } | ||
| 75 |