1
1
mirror of https://github.com/github/semantic.git synced 2024-12-24 23:42:31 +03:00

Generalize the parser to arbitrary carriers for Core.

This commit is contained in:
Rob Rix 2019-07-29 11:24:22 -04:00
parent e2db378be6
commit 4fdef93d72
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7

View File

@ -1,4 +1,4 @@
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts, TypeOperators #-}
module Data.Core.Parser
( module Text.Trifecta
, core
@ -10,14 +10,13 @@ module Data.Core.Parser
-- Consult @doc/grammar.md@ for an EBNF grammar.
import Control.Applicative
import Control.Effect.Sum
import Control.Effect.Carrier
import qualified Data.Char as Char
import Data.Core (Ann, Core)
import Data.Core (Core)
import qualified Data.Core as Core
import Data.Foldable (foldl')
import Data.Name
import Data.String
import Data.Term
import qualified Text.Parser.Token as Token
import qualified Text.Parser.Token.Highlight as Highlight
import Text.Trifecta hiding (ident)
@ -47,22 +46,22 @@ identifier = choice [quote, plain] <?> "identifier" where
-- * Parsers (corresponding to EBNF)
core :: (TokenParsing m, Monad m) => m (Term (Ann :+: Core) User)
core :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t User)
core = expr
expr :: (TokenParsing m, Monad m) => m (Term (Ann :+: Core) User)
expr :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t User)
expr = ifthenelse <|> lambda <|> rec <|> load <|> assign
assign :: (TokenParsing m, Monad m) => m (Term (Ann :+: Core) User)
assign :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t User)
assign = application <**> (flip (Core..=) <$ symbolic '=' <*> application <|> pure id) <?> "assignment"
application :: (TokenParsing m, Monad m) => m (Term (Ann :+: Core) User)
application :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t User)
application = projection `chainl1` (pure (Core.$$))
projection :: (TokenParsing m, Monad m) => m (Term (Ann :+: Core) User)
projection :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t User)
projection = foldl' (Core....) <$> atom <*> many (namedValue <$ dot <*> name)
atom :: (TokenParsing m, Monad m) => m (Term (Ann :+: Core) User)
atom :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t User)
atom = choice
[ comp
, lit
@ -70,29 +69,29 @@ atom = choice
, parens expr
]
comp :: (TokenParsing m, Monad m) => m (Term (Ann :+: Core) User)
comp :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t User)
comp = braces (Core.do' <$> sepEndByNonEmpty statement semi) <?> "compound statement"
statement :: (TokenParsing m, Monad m) => m (Maybe (Named User) Core.:<- Term (Ann :+: Core) User)
statement :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (Maybe (Named User) Core.:<- t User)
statement
= try ((Core.:<-) . Just <$> name <* symbol "<-" <*> expr)
<|> (Nothing Core.:<-) <$> expr
<?> "statement"
ifthenelse :: (TokenParsing m, Monad m) => m (Term (Ann :+: Core) User)
ifthenelse :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t User)
ifthenelse = Core.if'
<$ reserved "if" <*> expr
<* reserved "then" <*> expr
<* reserved "else" <*> expr
<?> "if-then-else statement"
rec :: (TokenParsing m, Monad m) => m (Term (Ann :+: Core) User)
rec :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t User)
rec = Core.rec <$ reserved "rec" <*> name <* symbolic '=' <*> expr <?> "recursive binding"
load :: (TokenParsing m, Monad m) => m (Term (Ann :+: Core) User)
load :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t User)
load = Core.load <$ reserved "load" <*> expr
lvalue :: (TokenParsing m, Monad m) => m (Term (Ann :+: Core) User)
lvalue :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t User)
lvalue = choice
[ projection
, ident
@ -104,7 +103,7 @@ lvalue = choice
name :: (TokenParsing m, Monad m) => m (Named User)
name = named' <$> identifier <?> "name"
lit :: (TokenParsing m, Monad m) => m (Term (Ann :+: Core) User)
lit :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t User)
lit = let x `given` n = x <$ reserved n in choice
[ Core.bool True `given` "#true"
, Core.bool False `given` "#false"
@ -119,13 +118,13 @@ lit = let x `given` n = x <$ reserved n in choice
, '\t' <$ string "t"
] <?> "escape sequence"
record :: (TokenParsing m, Monad m) => m (Term (Ann :+: Core) User)
record :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t User)
record = Core.record <$ reserved "#record" <*> braces (sepEndBy ((,) <$> identifier <* symbolic ':' <*> expr) comma)
lambda :: (TokenParsing m, Monad m) => m (Term (Ann :+: Core) User)
lambda :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t User)
lambda = Core.lam <$ lambduh <*> name <* arrow <*> expr <?> "lambda" where
lambduh = symbolic 'λ' <|> symbolic '\\'
arrow = symbol "" <|> symbol "->"
ident :: (Monad m, TokenParsing m) => m (Term (Ann :+: Core) User)
ident :: (Applicative t, Monad m, TokenParsing m) => m (t User)
ident = pure . namedValue <$> name <?> "identifier"