Fix bulk of function header parser

tools/lsp/pascaligo/grammar.js

@@ -179,7 +179,8 @@ module.exports = grammar({
         field("body", $._expr),
       ),
 
-    _open_fun_decl: $ =>
+    fun_decl: $ =>
+      prec.right(0,
         seq(
           field("recursive", optional($.recursive)),
           'function',
@@ -193,13 +194,9 @@ module.exports = grammar({
             'with',
           )),
           field("body", $._expr),
-      ),
-
-    fun_decl: $ =>
-      seq(
-        field("_open_fun_decl", $._open_fun_decl),
           optional(';'),
         ),
+      ),
 
     parameters: $ => par(sepBy(';', field("parameter", $.param_decl))),
 
@@ -226,7 +223,7 @@ module.exports = grammar({
       choice(
         $.open_const_decl,
         $.open_var_decl,
-        $._open_fun_decl,
+        $.fun_decl,
       ),
 
     open_const_decl: $ =>

tools/lsp/squirrel/src/AST.hs

@@ -123,11 +123,13 @@ name = do
 
 contract :: Parser (Contract Range)
 contract = subtree "contract" do
-  (decls, info) <- range $ many "declaration" declaration
+  (decls, info) <- range do
+    many "declaration" declaration
   return (Contract info decls)
 
 declaration :: Parser (Declaration Range)
 declaration =
+  stubbed "declaration" do
     field "declaration" do
       (b, info) <- range binding
       return (ValueDecl info b)
@@ -146,31 +148,50 @@ binding = do
       field "recursive" do
         token "recursive"
     consume "function"
-    name <- field "name" do
+    name <- stubbed "name" do
+      field "name" do
         name
-    params <- field "parameters" $ par (many "param" paramDecl)
+    params <-
+      field "parameters" do
+        subtree "parameters" do
+          par do
+            many "param" do
+              notFollowedBy do
+                consumeOrDie ")"
+
+              stubbed "parameters" do
+                paramDecl
     consume ":"
-    ty     <- field "type" type_
+    ty <-
+      stubbed "type" do
+        field "type" type_
     consume "is"
-    get >>= traceShowM
-    expr   <- field "locals" anything
+    expr <- stubbed "body" do
+      field "locals" anything
     return (Function info (recur == Just "recursive") name params ty expr)
 
 paramDecl :: Parser (VarDecl Range)
 paramDecl = do
   info <- getRange
   "parameter" `field` do
+    subtree "param_decl" do
       info' <- getRange
       mutable <- do
-      "access" `subtree` select
-        [ do consume "var"
-             return $ Mutable info'
-        , do consume "const"
-             return $ Immutable info'
+        traceM "paramDecl"
+        stubbed "access" do
+          "access" `subtree` do
+            traceM "paramDecl"
+            select
+              [ consume "var"   >> return (Mutable info')
+              , consume "const" >> return (Immutable info')
               ]
-    name <- field "name" name
+      name <-
+        stubbed "name" do
+          field "name" name
       consume ":"
-    ty <- field "type" type_
+      ty <-
+        stubbed "type" do
+          field "type" type_
       return (Decl info mutable name ty)
 
 newtype_ = do
@@ -182,8 +203,11 @@ type_ =
   where
     fun_type :: Parser (Type Range)
     fun_type = do
+      stubbed "type" do
+        subtree "fun_type" do
           info <- getRange
-      domain <- field "domain" cartesian
+          domain <- stubbed "domain" do
+            field "domain" cartesian
           codomain <- optional do
             consume "->"
             fun_type
@@ -192,8 +216,12 @@ type_ =
             Nothing -> domain
 
     cartesian = do
+      stubbed "cartesian" do
+        subtree "cartesian" do
           info <- getRange
-      Product info <$> some "corety" core_type
+          Product info <$> some "corety" do
+            field "element" do
+              core_type
 
     core_type = do
       info <- getRange
@@ -206,4 +234,4 @@ type_ =
 tuple :: Text -> Parser a -> Parser [a]
 tuple msg = par . some msg
 
-example = "../../ligo/src/test/contracts/address.ligo"
+example = "../../../src/test/contracts/address.ligo"

tools/lsp/squirrel/src/Parser.hs

@@ -8,7 +8,6 @@ import Control.Monad.Except
 import Control.Monad.Identity
 
 import Data.Text.Encoding
--- import Data.Traversable (for)
 import Data.Text (Text, pack, unpack)
 
 import qualified Data.ByteString as ByteString
@@ -16,7 +15,7 @@ import Data.ByteString (ByteString)
 
 import ParseTree
 
--- import Debug.Trace
+import Debug.Trace
 
 data Error
   = Expected Text Range
@@ -54,7 +53,7 @@ takeNext msg = do
         }
       return t
 
-field :: Stubbed a => Text -> Parser a -> Parser a
+field :: Text -> Parser a -> Parser a
 field name parser = do
   grove <- gets pfGrove
   case grove of
@@ -77,7 +76,7 @@ field name parser = do
         , pfRange = ptRange
         }
 
-      stubbed name parser <* put st
+      parser <* put st
         { pfGrove = grove'
         , pfRange = if firstOne then diffRange rng ptRange else rng
         }
@@ -116,13 +115,25 @@ many :: Text -> Parser a -> Parser [a]
 many msg p = many'
   where
     many' = some' <|> pure []
-    some' = (:) <$> (productive msg p) <*> many'
+    some' = do
+      (x, consumed) <- productive p
+      if consumed then do
+        xs <- many'
+        return (x : xs)
+      else do
+        return [x]
 
 some :: Text -> Parser a -> Parser [a]
 some msg p = some'
   where
     many' = some' <|> pure []
-    some' = (:) <$> (productive msg p) <*> many'
+    some' = do
+      (x, consumed) <- productive p
+      if consumed then do
+        xs <- many'
+        return (x : xs)
+      else do
+        return [x]
 
 getTreeID :: Parser (Maybe Int)
 getTreeID = Parser do
@@ -130,14 +141,12 @@ getTreeID = Parser do
     [] -> Nothing
     (_, tree) : _ -> Just (ptID tree)
 
-productive :: Text -> Parser a -> Parser a
-productive msg p = do
+productive :: Parser a -> Parser (a, Bool)
+productive p = do
   was <- getTreeID
   res <- p
   now <- getTreeID
-  unless (was /= now) do
-    error ("unproductive: " ++ unpack msg)
-  return res
+  return (res, was /= now)
 
 data ParserEnv = ParserEnv
   { peRange  :: Range
@@ -182,6 +191,12 @@ consume node = do
   when (ptName /= node) do
     tell [Expected node ptRange]
 
+consumeOrDie :: Text -> Parser ()
+consumeOrDie node = do
+  ParseTree {ptName, ptRange} <- takeNext node
+  when (ptName /= node) do
+    throwError $ Expected node ptRange
+
 cutOut :: ByteString -> ParseTree -> Text
 cutOut bs (ParseTree _ _ s f _ _) =
   decodeUtf8 $ ByteString.take (f - s) (ByteString.drop s bs)
@@ -207,11 +222,19 @@ delete k ((k', v) : rest) =
   then rest
   else (k', v) : delete k rest
 
+notFollowedBy :: Parser a -> Parser ()
+notFollowedBy parser = do
+  good <- do
+      parser
+      return False
+    <|> do
+      return True
+
+  unless good do
+    die "notFollowedBy"
+
 class Stubbed a where
   stub :: Error -> a
 
-instance Stubbed [a] where
-  stub _ = []
-
 instance Stubbed Text where
-  stub e = pack ("<" <> show e <> ">")
+  stub = pack . show