| Line No. | Rev | Author | Line |
|---|---|---|---|
| 1 | 1 | paulosilva | |
| 2 | {-# LANGUAGE FlexibleContexts #-} | ||
| 3 | {-# OPTIONS_GHC -Wall #-} | ||
| 4 | |||
| 5 | ------------------------------------------------------------------------------- | ||
| 6 | |||
| 7 | {- | | ||
| 8 | Module : Language.Type.Parser | ||
| 9 | Description : Parser of the type 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.Type.Parser ( | ||
| 22 | parser, | ||
| 23 | parseType | ||
| 24 | ) where | ||
| 25 | |||
| 26 | import Control.GalcError | ||
| 27 | import Control.Monad.Error | ||
| 28 | import Data.Existential | ||
| 29 | import Language.Type.Syntax | ||
| 30 | import Text.ParserCombinators.Parsec | ||
| 31 | import Text.ParserCombinators.Parsec.Language | ||
| 32 | import qualified Text.ParserCombinators.Parsec.Token as P | ||
| 33 | |||
| 34 | ------------------------------------------------------------------------------- | ||
| 35 | |||
| 36 | type TypeParser = Parser TypeBox | ||
| 37 | |||
| 38 | ------------------------------------------------------------------------------- | ||
| 39 | |||
| 40 | reservNames :: [String] | ||
| 41 | reservNames = [ | ||
| 42 | "TVar", "One", "Bool", "Char", "String", "Int", "Float", "Prod", | ||
| 43 | "Either", "Maybe", "List", "Set", "Map", "Fun", "Rel", "Ord", "GC" | ||
| 44 | ] | ||
| 45 | |||
| 46 | ------------------------------------------------------------------------------- | ||
| 47 | |||
| 48 | lexer :: P.TokenParser st | ||
| 49 | lexer = P.makeTokenParser $ emptyDef { P.reservedNames = reservNames } | ||
| 50 | |||
| 51 | ------------------------------------------------------------------------------- | ||
| 52 | |||
| 53 | reserved :: String -> CharParser st () | ||
| 54 | reserved = P.reserved lexer | ||
| 55 | |||
| 56 | whiteSpace :: CharParser st () | ||
| 57 | whiteSpace = P.whiteSpace lexer | ||
| 58 | |||
| 59 | parens :: CharParser st TypeBox -> CharParser st TypeBox | ||
| 60 | parens = P.parens lexer | ||
| 61 | |||
| 62 | identifier :: CharParser st String | ||
| 63 | identifier = P.identifier lexer | ||
| 64 | |||
| 65 | ------------------------------------------------------------------------------- | ||
| 66 | |||
| 67 | parser :: MonadError GalcError m => String -> m TypeBox | ||
| 68 | parser = either2error (ParsingError . show) . parse mainTypeParser "" | ||
| 69 | |||
| 70 | ------------------------------------------------------------------------------- | ||
| 71 | |||
| 72 | mainTypeParser :: TypeParser | ||
| 73 | mainTypeParser = do | ||
| 74 | whiteSpace | ||
| 75 | t <- parseType | ||
| 76 | eof | ||
| 77 | return t | ||
| 78 | |||
| 79 | ------------------------------------------------------------------------------- | ||
| 80 | |||
| 81 | parseType :: TypeParser | ||
| 82 | parseType = | ||
| 83 | parens parseType <|> | ||
| 84 | parseTVar <|> | ||
| 85 | parseOne <|> | ||
| 86 | parseBool <|> | ||
| 87 | parseChar <|> | ||
| 88 | parseString <|> | ||
| 89 | parseInt <|> | ||
| 90 | parseFloat <|> | ||
| 91 | parseProd <|> | ||
| 92 | parseEither <|> | ||
| 93 | parseMaybe <|> | ||
| 94 | parseList <|> | ||
| 95 | parseSet <|> | ||
| 96 | parseMap <|> | ||
| 97 | parseFun <|> | ||
| 98 | parseRel <|> | ||
| 99 | parseOrd <|> | ||
| 100 | parseGC | ||
| 101 | |||
| 102 | ------------------------------------------------------------------------------- | ||
| 103 | |||
| 104 | parseTVar :: TypeParser | ||
| 105 | parseTVar = do | ||
| 106 | reserved "TVar" | ||
| 107 | tid <- identifier | ||
| 108 | return $ Hide $ TVar tid | ||
| 109 | |||
| 110 | ------------------------------------------------------------------------------- | ||
| 111 | |||
| 112 | parseOne :: TypeParser | ||
| 113 | parseOne = do | ||
| 114 | reserved "One" | ||
| 115 | return $ Hide One | ||
| 116 | |||
| 117 | ------------------------------------------------------------------------------- | ||
| 118 | |||
| 119 | parseBool :: TypeParser | ||
| 120 | parseBool = do | ||
| 121 | reserved "Bool" | ||
| 122 | return $ Hide Bool | ||
| 123 | |||
| 124 | ------------------------------------------------------------------------------- | ||
| 125 | |||
| 126 | parseChar :: TypeParser | ||
| 127 | parseChar = do | ||
| 128 | reserved "Char" | ||
| 129 | return $ Hide Char | ||
| 130 | |||
| 131 | ------------------------------------------------------------------------------- | ||
| 132 | |||
| 133 | parseString :: TypeParser | ||
| 134 | parseString = do | ||
| 135 | reserved "String" | ||
| 136 | return $ Hide String | ||
| 137 | |||
| 138 | ------------------------------------------------------------------------------- | ||
| 139 | |||
| 140 | parseInt :: TypeParser | ||
| 141 | parseInt = do | ||
| 142 | reserved "Int" | ||
| 143 | return $ Hide Int | ||
| 144 | |||
| 145 | ------------------------------------------------------------------------------- | ||
| 146 | |||
| 147 | parseFloat :: TypeParser | ||
| 148 | parseFloat = do | ||
| 149 | reserved "Float" | ||
| 150 | return $ Hide Float | ||
| 151 | |||
| 152 | ------------------------------------------------------------------------------- | ||
| 153 | |||
| 154 | parseProd :: TypeParser | ||
| 155 | parseProd = do | ||
| 156 | reserved "Prod" | ||
| 157 | Hide t1 <- parseType | ||
| 158 | Hide t2 <- parseType | ||
| 159 | return $ Hide (Prod t1 t2) | ||
| 160 | |||
| 161 | ------------------------------------------------------------------------------- | ||
| 162 | |||
| 163 | parseEither :: TypeParser | ||
| 164 | parseEither = do | ||
| 165 | reserved "Either" | ||
| 166 | Hide t1 <- parseType | ||
| 167 | Hide t2 <- parseType | ||
| 168 | return $ Hide (Either t1 t2) | ||
| 169 | |||
| 170 | ------------------------------------------------------------------------------- | ||
| 171 | |||
| 172 | parseMaybe :: TypeParser | ||
| 173 | parseMaybe = do | ||
| 174 | reserved "Maybe" | ||
| 175 | Hide t1 <- parseType | ||
| 176 | return $ Hide (Maybe t1) | ||
| 177 | |||
| 178 | ------------------------------------------------------------------------------- | ||
| 179 | |||
| 180 | parseList :: TypeParser | ||
| 181 | parseList = do | ||
| 182 | reserved "List" | ||
| 183 | Hide t1 <- parseType | ||
| 184 | return $ Hide (List t1) | ||
| 185 | |||
| 186 | ------------------------------------------------------------------------------- | ||
| 187 | |||
| 188 | parseSet :: TypeParser | ||
| 189 | parseSet = do | ||
| 190 | reserved "Set" | ||
| 191 | Hide t1 <- parseType | ||
| 192 | return $ Hide (Set t1) | ||
| 193 | |||
| 194 | ------------------------------------------------------------------------------- | ||
| 195 | |||
| 196 | parseMap :: TypeParser | ||
| 197 | parseMap = do | ||
| 198 | reserved "Map" | ||
| 199 | Hide t1 <- parseType | ||
| 200 | Hide t2 <- parseType | ||
| 201 | return $ Hide (Map t1 t2) | ||
| 202 | |||
| 203 | ------------------------------------------------------------------------------- | ||
| 204 | |||
| 205 | parseFun :: TypeParser | ||
| 206 | parseFun = do | ||
| 207 | reserved "Fun" | ||
| 208 | Hide t1 <- parseType | ||
| 209 | Hide t2 <- parseType | ||
| 210 | return $ Hide (Fun t1 t2) | ||
| 211 | |||
| 212 | ------------------------------------------------------------------------------- | ||
| 213 | |||
| 214 | parseRel :: TypeParser | ||
| 215 | parseRel = do | ||
| 216 | reserved "Rel" | ||
| 217 | Hide t1 <- parseType | ||
| 218 | Hide t2 <- parseType | ||
| 219 | return $ Hide (Rel t1 t2) | ||
| 220 | |||
| 221 | ------------------------------------------------------------------------------- | ||
| 222 | |||
| 223 | parseOrd :: TypeParser | ||
| 224 | parseOrd = do | ||
| 225 | reserved "Ord" | ||
| 226 | Hide t1 <- parseType | ||
| 227 | return $ Hide (Ord t1) | ||
| 228 | |||
| 229 | ------------------------------------------------------------------------------- | ||
| 230 | |||
| 231 | parseGC :: TypeParser | ||
| 232 | parseGC = do | ||
| 233 | reserved "GC" | ||
| 234 | Hide t1 <- parseType | ||
| 235 | Hide t2 <- parseType | ||
| 236 | return $ Hide (GC t1 t2) | ||
| 237 | |||
| 238 | ------------------------------------------------------------------------------- |