| Line No. | Rev | Author | Line |
|---|---|---|---|
| 1 | 1 | paulosilva | |
| 2 | {-# LANGUAGE FlexibleContexts #-} | ||
| 3 | {-# OPTIONS_GHC -Wall #-} | ||
| 4 | |||
| 5 | ------------------------------------------------------------------------------- | ||
| 6 | |||
| 7 | {- | | ||
| 8 | Module : Language.Derivation.Parser | ||
| 9 | Description : | ||
| 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.Derivation.Parser ( | ||
| 22 | parser, | ||
| 23 | parseDeriv | ||
| 24 | ) where | ||
| 25 | |||
| 26 | import Control.GalcError | ||
| 27 | import Control.Monad.Error | ||
| 28 | import Language.Derivation.Syntax | ||
| 29 | import Text.ParserCombinators.Parsec | ||
| 30 | import Text.ParserCombinators.Parsec.Language | ||
| 31 | import qualified Text.ParserCombinators.Parsec.Token as P | ||
| 32 | |||
| 33 | ------------------------------------------------------------------------------- | ||
| 34 | |||
| 35 | type DerivParser = Parser Derivation | ||
| 36 | |||
| 37 | ------------------------------------------------------------------------------- | ||
| 38 | |||
| 39 | reservNames :: [String] | ||
| 40 | reservNames = derivations | ||
| 41 | |||
| 42 | ------------------------------------------------------------------------------- | ||
| 43 | |||
| 44 | lexer :: P.TokenParser st | ||
| 45 | lexer = P.makeTokenParser $ emptyDef { P.reservedNames = reservNames } | ||
| 46 | |||
| 47 | ------------------------------------------------------------------------------- | ||
| 48 | |||
| 49 | reserved :: String -> CharParser st () | ||
| 50 | reserved = P.reserved lexer | ||
| 51 | |||
| 52 | whiteSpace :: CharParser st () | ||
| 53 | whiteSpace = P.whiteSpace lexer | ||
| 54 | |||
| 55 | identifier :: CharParser st String | ||
| 56 | identifier = P.identifier lexer | ||
| 57 | |||
| 58 | ------------------------------------------------------------------------------- | ||
| 59 | |||
| 60 | parser :: MonadError GalcError m => String -> m Derivation | ||
| 61 | parser = either2error (ParsingError . show) . parse mainDerivParser "" | ||
| 62 | |||
| 63 | ------------------------------------------------------------------------------- | ||
| 64 | |||
| 65 | mainDerivParser :: DerivParser | ||
| 66 | mainDerivParser = do | ||
| 67 | whiteSpace | ||
| 68 | t <- parseDeriv | ||
| 69 | eof | ||
| 70 | return t | ||
| 71 | |||
| 72 | ------------------------------------------------------------------------------- | ||
| 73 | |||
| 74 | parseDeriv :: DerivParser | ||
| 75 | parseDeriv = | ||
| 76 | parseInv <|> | ||
| 77 | parseShunt <|> | ||
| 78 | parseDistrLow <|> | ||
| 79 | parseDistrUp <|> | ||
| 80 | parseMonotUp <|> | ||
| 81 | parseMonotLow <|> | ||
| 82 | parseTopPreserv <|> | ||
| 83 | parseBotPreserv <|> | ||
| 84 | parseCancUp <|> | ||
| 85 | parseCancLow <|> | ||
| 86 | parseFree <|> | ||
| 87 | parseApply | ||
| 88 | |||
| 89 | ------------------------------------------------------------------------------- | ||
| 90 | |||
| 91 | parseInv :: DerivParser | ||
| 92 | parseInv = do | ||
| 93 | reserved "inv" | ||
| 94 | drv <- parseDeriv | ||
| 95 | return $ Inv drv | ||
| 96 | |||
| 97 | ------------------------------------------------------------------------------- | ||
| 98 | |||
| 99 | parseShunt :: DerivParser | ||
| 100 | parseShunt = do | ||
| 101 | reserved "shunt" | ||
| 102 | ident <- identifier | ||
| 103 | return $ Shunt ident | ||
| 104 | |||
| 105 | ------------------------------------------------------------------------------- | ||
| 106 | |||
| 107 | parseDistrLow :: DerivParser | ||
| 108 | parseDistrLow = do | ||
| 109 | reserved "distr_low" | ||
| 110 | ident <- identifier | ||
| 111 | return $ DistrLow ident | ||
| 112 | |||
| 113 | ------------------------------------------------------------------------------- | ||
| 114 | |||
| 115 | parseDistrUp :: DerivParser | ||
| 116 | parseDistrUp = do | ||
| 117 | reserved "distr_up" | ||
| 118 | ident <- identifier | ||
| 119 | return $ DistrUp ident | ||
| 120 | |||
| 121 | ------------------------------------------------------------------------------- | ||
| 122 | |||
| 123 | parseMonotUp :: DerivParser | ||
| 124 | parseMonotUp = do | ||
| 125 | reserved "monot_up" | ||
| 126 | ident <- identifier | ||
| 127 | return $ MonotUp ident | ||
| 128 | |||
| 129 | ------------------------------------------------------------------------------- | ||
| 130 | |||
| 131 | parseMonotLow :: DerivParser | ||
| 132 | parseMonotLow = do | ||
| 133 | reserved "monot_low" | ||
| 134 | ident <- identifier | ||
| 135 | return $ MonotLow ident | ||
| 136 | |||
| 137 | ------------------------------------------------------------------------------- | ||
| 138 | |||
| 139 | parseTopPreserv :: DerivParser | ||
| 140 | parseTopPreserv = do | ||
| 141 | reserved "top_preserving" | ||
| 142 | ident <- identifier | ||
| 143 | return $ TopPreserv ident | ||
| 144 | |||
| 145 | ------------------------------------------------------------------------------- | ||
| 146 | |||
| 147 | parseBotPreserv :: DerivParser | ||
| 148 | parseBotPreserv = do | ||
| 149 | reserved "bot_preserving" | ||
| 150 | ident <- identifier | ||
| 151 | return $ BotPreserv ident | ||
| 152 | |||
| 153 | ------------------------------------------------------------------------------- | ||
| 154 | |||
| 155 | parseCancUp :: DerivParser | ||
| 156 | parseCancUp = do | ||
| 157 | reserved "canc_up" | ||
| 158 | ident <- identifier | ||
| 159 | return $ CancUp ident | ||
| 160 | |||
| 161 | ------------------------------------------------------------------------------- | ||
| 162 | |||
| 163 | parseCancLow :: DerivParser | ||
| 164 | parseCancLow = do | ||
| 165 | reserved "canc_low" | ||
| 166 | ident <- identifier | ||
| 167 | return $ CancLow ident | ||
| 168 | |||
| 169 | ------------------------------------------------------------------------------- | ||
| 170 | |||
| 171 | parseFree :: DerivParser | ||
| 172 | parseFree = do | ||
| 173 | reserved "free" | ||
| 174 | ident <- identifier | ||
| 175 | return $ Free ident | ||
| 176 | |||
| 177 | ------------------------------------------------------------------------------- | ||
| 178 | |||
| 179 | parseApply :: DerivParser | ||
| 180 | parseApply = do | ||
| 181 | reserved "apply" | ||
| 182 | ident <- identifier | ||
| 183 | return $ Apply ident | ||
| 184 | |||
| 185 | ------------------------------------------------------------------------------- | ||
| 186 | |||
| 187 |