|
| 1 | +module Data.Core.Parser |
| 2 | + ( module Text.Trifecta |
| 3 | + , core |
| 4 | + , lit |
| 5 | + , expr |
| 6 | + , lvalue |
| 7 | + ) where |
| 8 | + |
| 9 | +-- Consult @doc/grammar.md@ for an EBNF grammar. |
| 10 | + |
| 11 | +import Control.Applicative |
| 12 | +import qualified Data.Char as Char |
| 13 | +import Data.Core |
| 14 | +import Data.Name |
| 15 | +import Data.Semigroup |
| 16 | +import Data.String |
| 17 | +import qualified Text.Parser.Token as Token |
| 18 | +import qualified Text.Parser.Token.Highlight as Highlight |
| 19 | +import Text.Trifecta hiding (ident) |
| 20 | + |
| 21 | +-- * Identifier styles and derived parsers |
| 22 | + |
| 23 | +validIdentifierStart :: Char -> Bool |
| 24 | +validIdentifierStart c = not (Char.isDigit c) && isSimpleCharacter c |
| 25 | + |
| 26 | +coreIdents :: TokenParsing m => IdentifierStyle m |
| 27 | +coreIdents = Token.IdentifierStyle |
| 28 | + { _styleName = "core" |
| 29 | + , _styleStart = satisfy validIdentifierStart |
| 30 | + , _styleLetter = satisfy isSimpleCharacter |
| 31 | + , _styleReserved = reservedNames |
| 32 | + , _styleHighlight = Highlight.Identifier |
| 33 | + , _styleReservedHighlight = Highlight.ReservedIdentifier |
| 34 | + } |
| 35 | + |
| 36 | +reserved :: (TokenParsing m, Monad m) => String -> m () |
| 37 | +reserved = Token.reserve coreIdents |
| 38 | + |
| 39 | +identifier :: (TokenParsing m, Monad m, IsString s) => m s |
| 40 | +identifier = choice [quote, plain] <?> "identifier" where |
| 41 | + plain = Token.ident coreIdents |
| 42 | + quote = between (string "#{") (symbol "}") (fromString <$> some (noneOf "{}")) |
| 43 | + |
| 44 | +-- * Parsers (corresponding to EBNF) |
| 45 | + |
| 46 | +core :: (TokenParsing m, Monad m) => m Core |
| 47 | +core = expr |
| 48 | + |
| 49 | +expr :: (TokenParsing m, Monad m) => m Core |
| 50 | +expr = atom `chainl1` go where |
| 51 | + go = choice [ (:.) <$ dot |
| 52 | + , (:$) <$ notFollowedBy dot |
| 53 | + ] |
| 54 | + |
| 55 | +atom :: (TokenParsing m, Monad m) => m Core |
| 56 | +atom = choice |
| 57 | + [ comp |
| 58 | + , ifthenelse |
| 59 | + , edge |
| 60 | + , lit |
| 61 | + , ident |
| 62 | + , assign |
| 63 | + , parens expr |
| 64 | + ] |
| 65 | + |
| 66 | +comp :: (TokenParsing m, Monad m) => m Core |
| 67 | +comp = braces (sconcat <$> sepEndByNonEmpty expr semi) <?> "compound statement" |
| 68 | + |
| 69 | +ifthenelse :: (TokenParsing m, Monad m) => m Core |
| 70 | +ifthenelse = If |
| 71 | + <$ reserved "if" <*> core |
| 72 | + <* reserved "then" <*> core |
| 73 | + <* reserved "else" <*> core |
| 74 | + <?> "if-then-else statement" |
| 75 | + |
| 76 | +assign :: (TokenParsing m, Monad m) => m Core |
| 77 | +assign = (:=) <$> try (lvalue <* symbolic '=') <*> core <?> "assignment" |
| 78 | + |
| 79 | +edge :: (TokenParsing m, Monad m) => m Core |
| 80 | +edge = kw <*> expr where kw = choice [ Edge Lexical <$ reserved "lexical" |
| 81 | + , Edge Import <$ reserved "import" |
| 82 | + , Load <$ reserved "load" |
| 83 | + ] |
| 84 | + |
| 85 | +lvalue :: (TokenParsing m, Monad m) => m Core |
| 86 | +lvalue = choice |
| 87 | + [ Let <$ reserved "let" <*> name |
| 88 | + , ident |
| 89 | + , parens expr |
| 90 | + ] |
| 91 | + |
| 92 | +-- * Literals |
| 93 | + |
| 94 | +name :: (TokenParsing m, Monad m) => m Name |
| 95 | +name = choice [regular, strpath] <?> "name" where |
| 96 | + regular = User <$> identifier |
| 97 | + strpath = Path <$> between (symbolic '"') (symbolic '"') (some $ noneOf "\"") |
| 98 | + |
| 99 | +lit :: (TokenParsing m, Monad m) => m Core |
| 100 | +lit = let x `given` n = x <$ reserved n in choice |
| 101 | + [ Bool True `given` "#true" |
| 102 | + , Bool False `given` "#false" |
| 103 | + , Unit `given` "#unit" |
| 104 | + , Frame `given` "#frame" |
| 105 | + , lambda |
| 106 | + ] <?> "literal" |
| 107 | + |
| 108 | +lambda :: (TokenParsing m, Monad m) => m Core |
| 109 | +lambda = Lam <$ lambduh <*> name <* arrow <*> core <?> "lambda" where |
| 110 | + lambduh = symbolic 'λ' <|> symbolic '\\' |
| 111 | + arrow = symbol "→" <|> symbol "->" |
| 112 | + |
| 113 | +ident :: (Monad m, TokenParsing m) => m Core |
| 114 | +ident = Var <$> name <?> "identifier" |
| 115 | + |
0 commit comments