Make it parse let-expressions

This commit is contained in:
Kirill Andreev 2020-05-01 22:41:07 +04:00
parent ad7650ea48
commit f3c537d2ca
No known key found for this signature in database
GPG Key ID: CF7DA79DE4785A47
3 changed files with 48 additions and 10 deletions

View File

@ -181,11 +181,11 @@ module.exports = grammar({
':',
field("type", $._type_expr),
'is',
field("body", $._let_expr),
field("body", $.let_expr),
),
),
_let_expr: $ =>
let_expr: $ =>
choice(
seq(
field("locals", $.block),

View File

@ -27,8 +27,8 @@ declaration :: Parser (Declaration Range)
declaration =
stubbed "declaration" do
field "declaration" do
(b, info) <- range binding
return (ValueDecl info b)
(b, info) <- range binding
return (ValueDecl info b)
par x = do
consume "("
@ -63,12 +63,38 @@ binding = do
field "type" type_
consume "is"
exp <- stubbed "body" do
field "expr" expr
field "body" letExpr
return (Function info (recur == Just "recursive") name params ty exp)
expr :: Parser (Expr Range)
expr = do
fallback "expr"
expr = select
[ Ident <$> getRange <*> name
-- , ident
-- , constant
]
where
-- $.case_expr,
-- $.cond_expr,
-- $.disj_expr,
-- $.fun_expr,
letExpr = do
subtree "let_expr" do
r <- getRange
decls <- optional do
field "locals" do
subtree "block" do
many "decl" do
field "statement" do
declaration
body <- field "body" do
-- gets pfGrove >>= traceShowM
stubbed "expr" do
expr
return case decls of
Just them -> Let r them body
Nothing -> body
paramDecl :: Parser (VarDecl Range)
paramDecl = do

View File

@ -34,6 +34,8 @@ instance Stubbed (Declaration info) where stub = WrongDecl
data Binding info
= Irrefutable info (Pattern info) (Expr info)
| Function info Bool (Name info) [VarDecl info] (Type info) (Expr info)
| Var info (Name info) (Type info) (Expr info)
| Const info (Name info) (Type info) (Expr info)
| WrongBinding Error
deriving (Show) via PP (Binding info)
@ -71,7 +73,7 @@ data Expr info
= Let info [Declaration info] (Expr info)
| Apply info (Expr info) [Expr info]
| Constant info (Constant info)
| Ident info (QualifiedName info)
| Ident info (Name info)
| WrongExpr Error
deriving (Show) via PP (Expr info)
@ -151,6 +153,16 @@ instance Pretty (Binding i) where
)
2
(pp body)
Var _ name ty value ->
hang
("var" <+> pp name <+> ":" <+> pp ty <+> ":=")
2
(pp value)
Const _ name ty body ->
hang
("var" <+> pp name <+> ":" <+> pp ty <+> "=")
2
(pp body)
WrongBinding err ->
pp err
@ -187,8 +199,8 @@ instance Pretty (Type i) where
instance Pretty (Expr i) where
pp = \case
Let _ decls body -> hang "let" 2 (vcat $ map pp decls)
<> hang "in" 2 (pp body)
Let _ decls body -> hang "block {" 2 (vcat $ map pp decls)
$$ hang "} with" 2 (pp body)
Apply _ f xs -> pp f <> tuple xs
Constant _ constant -> pp constant
Ident _ qname -> pp qname