Add [Big]Map literal/removal/projection parser

tools/lsp/pascaligo/grammar.js

@@ -560,8 +560,8 @@ module.exports = grammar({
         $.big_map_injection,
       ),
 
-    map_injection: $ => injection('map', $.binding),
+    map_injection: $ => injection('map', field("binding", $.binding)),
-    big_map_injection: $ => injection('big_map', $.binding),
+    big_map_injection: $ => injection('big_map', field("binding", $.binding)),
 
     map_lookup: $ =>
       seq(

tools/lsp/squirrel/src/AST/Parser.hs

@@ -97,6 +97,11 @@ expr = stubbed "expr" do
     , has_type
     , string_literal
     , attributes
+    , tuple_expr
+    , moduleQualified
+    , big_map_expr
+    , map_expr
+    , map_remove
     -- , constant
     ]
   where
@@ -105,6 +110,53 @@ expr = stubbed "expr" do
   -- $.disj_expr,
   -- $.fun_expr,
 
+map_remove :: Parser (Expr ASTInfo)
+map_remove = do
+  subtree "map_remove" do
+    ctor MapRemove
+      <*> inside "key" expr
+      <*> inside "container" do
+        inside ":path" do
+          qname
+
+big_map_expr :: Parser (Expr ASTInfo)
+big_map_expr = do
+  subtree "big_map_injection" do
+    ctor BigMap <*> do
+      many "binding" do
+        inside "binding" do
+          map_binding
+
+map_expr :: Parser (Expr ASTInfo)
+map_expr = do
+  subtree "map_injection" do
+    ctor Map <*> do
+      many "binding" do
+        inside "binding" do
+          map_binding
+
+map_binding :: Parser (MapBinding ASTInfo)
+map_binding = do
+  subtree "binding" do
+    ctor MapBinding
+      <*> inside "key"   expr
+      <*> inside "value" expr
+
+moduleQualified :: Parser (Expr ASTInfo)
+moduleQualified = do
+  subtree "module_field" do
+    ctor Ident <*> do
+      ctor QualifiedName
+        <*> inside "module" capitalName
+        <*> do pure <$> do ctor At <*> inside "method" name
+
+tuple_expr :: Parser (Expr ASTInfo)
+tuple_expr = do
+  subtree "tuple_expr" do
+    ctor Tuple <*> do
+      many "tuple element" do
+        inside "element" expr
+
 attributes :: Parser (Expr ASTInfo)
 attributes = do
   subtree "attr_decl" do
@@ -143,11 +195,29 @@ assign :: Parser (Expr ASTInfo)
 assign = do
   subtree "assignment" do
     ctor Assign
-      <*> inside "LHS" do
+      <*> inside "LHS" lhs
-              inside ":path" qname
-          <|> projection
       <*> inside "RHS" expr
 
+lhs :: Parser (LHS ASTInfo)
+lhs =
+  do ctor LHS
+       <*> inside "container:path" do
+             qname <|> projection
+       <*> pure Nothing
+  <|>
+  do ctor LHS
+       <*> subtree "path" do
+             qname <|> projection
+       <*> pure Nothing
+  <|>
+  do subtree "map_lookup" do
+       ctor LHS
+         <*> inside "container:path" do
+               qname <|> projection
+         <*> inside "index" do
+               Just <$> expr
+
+
 tez_literal :: Parser (Expr ASTInfo)
 tez_literal = do
   ctor Constant <*> do
@@ -170,6 +240,7 @@ method_call = do
 
 projection :: Parser (QualifiedName ASTInfo)
 projection = do
+  gets pfGrove >>= traceShowM
   subtree "data_projection" do
     ctor QualifiedName
       <*> inside "struct" name
@@ -177,9 +248,12 @@ projection = do
 
 selection :: Parser (Path ASTInfo)
 selection = do
-  inside "index:selection"
+    inside "index:selection"
-    $   do ctor At <*> name
+      $   do ctor At <*> name
-    <|> do ctor Ix <*> token "Int"
+      <|> do ctor Ix <*> token "Int"
+  <|>
+    inside "index" do
+      do ctor Ix <*> token "Int"
 
 par_call :: Parser (Expr ASTInfo)
 par_call = do
@@ -315,7 +389,7 @@ type_ =
         [ ctor TVar <*> name
         , subtree "invokeBinary" do
             ctor TApply
-              <*> inside "typeConstr" name
+              <*> inside "typeConstr" name'
               <*> inside "arguments"  typeTuple
         , subtree "invokeUnary" do
             ctor TApply
@@ -339,5 +413,20 @@ typeTuple = do
 -- example = "../../../src/test/contracts/annotation.ligo"
 -- example = "../../../src/test/contracts/arithmetic.ligo"
 -- example = "../../../src/test/contracts/assign.ligo"
-example = "../../../src/test/contracts/attributes.ligo"
+-- example = "../../../src/test/contracts/attributes.ligo"
+-- example = "../../../src/test/contracts/bad_timestamp.ligo"
+-- example = "../../../src/test/contracts/bad_type_operator.ligo"
+-- example = "../../../src/test/contracts/balance_constant.ligo"
+example = "../../../src/test/contracts/big_map.ligo"
+-- example = "../../../src/test/contracts/application.ligo"
+-- example = "../../../src/test/contracts/application.ligo"
+-- example = "../../../src/test/contracts/application.ligo"
+-- example = "../../../src/test/contracts/application.ligo"
+-- example = "../../../src/test/contracts/application.ligo"
+-- example = "../../../src/test/contracts/application.ligo"
+-- example = "../../../src/test/contracts/application.ligo"
+-- example = "../../../src/test/contracts/application.ligo"
+-- example = "../../../src/test/contracts/application.ligo"
+-- example = "../../../src/test/contracts/application.ligo"
+-- example = "../../../src/test/contracts/application.ligo"
 -- example = "../../../src/test/contracts/application.ligo"

tools/lsp/squirrel/src/AST/Types.hs

@@ -87,15 +87,34 @@ data Expr info
   | UnOp      info Text (Expr info)
   | Record    info [Assignment info]
   | If        info (Expr info) (Expr info) (Expr info)
-  | Assign    info (QualifiedName info) (Expr info)
+  | Assign    info (LHS info) (Expr info)
   | List      info [Expr info]
+  | Tuple     info [Expr info]
   | Annot     info (Expr info) (Type info)
   | Attrs     info [Text]
+  | BigMap    info [MapBinding info]
+  | Map       info [MapBinding info]
+  | MapRemove info (Expr info) (QualifiedName info)
+  | SetRemove info (Expr info) (QualifiedName info)
   | WrongExpr      Error
   deriving (Show) via PP (Expr info)
 
 instance Stubbed (Expr info) where stub = WrongExpr
 
+data LHS info
+  = LHS info (QualifiedName info) (Maybe (Expr info))
+  | WrongLHS Error
+  deriving (Show) via PP (LHS info)
+
+instance Stubbed (LHS info) where stub = WrongLHS
+
+data MapBinding info
+  = MapBinding info (Expr info) (Expr info)
+  | WrongMapBinding Error
+  deriving (Show) via PP (MapBinding info)
+
+instance Stubbed (MapBinding info) where stub = WrongMapBinding
+
 data Assignment info
   = Assignment info (Name info) (Expr info)
   | WrongAssignment Error
@@ -159,7 +178,7 @@ instance Pretty (Contract i) where
   pp = \case
     Contract _ decls ->
       hang "(* contract *)" 2 do
-        vcat $ map (($$ empty) . pp) decls
+        vcat $ punctuate "\n" $ map (($$ empty) . pp) decls
 
     WrongContract err ->
       pp err
@@ -234,8 +253,7 @@ instance Pretty (Type i) where
 
 instance Pretty (Expr i) where
   pp = \case
-    Let       _ decls body -> hang "block {" 2 (vcat $ map pp decls)
+    Let       _ decls body -> "block {" $$ (nest 2 $ vcat $ punctuate "\n" $ map pp decls) $$ "}" $$ "with" $$ nest 2 (pp body)
-                           $$ hang "} with"  2 (pp body)
     Apply     _ f xs       -> pp f <> tuple xs
     Constant  _ constant   -> pp constant
     Ident     _ qname      -> pp qname
@@ -245,10 +263,20 @@ instance Pretty (Expr i) where
     If        _ b t e      -> fsep ["if" <+> pp b, nest 2 $ "then" <+> pp t, nest 2 $ "else" <+> pp e]
     Assign    _ l r        -> hang (pp l <+> ":=") 2 (pp r)
     List      _ l          -> "[" <> fsep (punctuate ";" $ map pp l) <> "]"
+    Tuple     _ l          -> "(" <> fsep (punctuate "," $ map pp l) <> ")"
     Annot     _ n t        -> ("(" <> pp n) <+> ":" <+> (pp t <> ")")
     Attrs     _ ts         -> "attributes [" <> fsep (punctuate ";" $ map pp ts) <> "]"
+    BigMap    _ bs         -> "big_map [" <> fsep (punctuate ";" $ map pp bs) <> "]"
+    Map       _ bs         ->     "map [" <> fsep (punctuate ";" $ map pp bs) <> "]"
+    MapRemove _ k m        -> hang ("remove" <+> pp k) 0 ("from" <+> "map" <+> pp m)
+    SetRemove _ k s        -> hang ("remove" <+> pp k) 0 ("from" <+> "set" <+> pp s)
     WrongExpr   err        -> pp err
 
+instance Pretty (MapBinding i) where
+  pp = \case
+    MapBinding _ k v -> hang (pp k <+> "->") 2 (pp v)
+    WrongMapBinding err -> pp err
+
 instance Pretty (Assignment i) where
   pp = \case
     Assignment      _ n e -> pp n <+> "=" <+> pp e
@@ -292,5 +320,10 @@ instance Pretty (TField i) where
     TField _ n t -> hang (pp n <> ":") 2 (pp t)
     WrongTField err -> pp err
 
+instance Pretty (LHS i) where
+  pp = \case
+    LHS _ qn mi -> pp qn <> foldMap (brackets . pp) mi
+    WrongLHS err -> pp err
+
 tuple :: Pretty p => [p] -> Doc
 tuple xs = parens (fsep $ punctuate "," $ map pp xs)

tools/lsp/squirrel/src/Parser.hs

@@ -289,6 +289,9 @@ instance Stubbed Text where
 instance Stubbed [a] where
   stub _ = []
 
+instance Stubbed a => Stubbed (Maybe a) where
+  stub = Just . stub
+
 inside :: Stubbed a => Text -> Parser a -> Parser a
 inside sig parser = do
   let (f, st') = Text.breakOn ":" sig