Make it parse let-expressions
This commit is contained in:
parent
ad7650ea48
commit
f3c537d2ca
@ -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),
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user