diff --git a/tools/lsp/pascaligo/grammar.js b/tools/lsp/pascaligo/grammar.js index 4b2b411fd..14fab952b 100644 --- a/tools/lsp/pascaligo/grammar.js +++ b/tools/lsp/pascaligo/grammar.js @@ -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), diff --git a/tools/lsp/squirrel/src/AST/Parser.hs b/tools/lsp/squirrel/src/AST/Parser.hs index 8ffc22e5d..6779c0d57 100644 --- a/tools/lsp/squirrel/src/AST/Parser.hs +++ b/tools/lsp/squirrel/src/AST/Parser.hs @@ -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 diff --git a/tools/lsp/squirrel/src/AST/Types.hs b/tools/lsp/squirrel/src/AST/Types.hs index 888156706..8629b7a9a 100644 --- a/tools/lsp/squirrel/src/AST/Types.hs +++ b/tools/lsp/squirrel/src/AST/Types.hs @@ -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