Fix camligo not registering fun/lam args

tools/lsp/squirrel/app/Main.hs

@@ -26,6 +26,7 @@ import           System.Exit
 import qualified System.Log                            as L
 
 import           Duplo.Error
+import           Duplo.Pretty
 import           Duplo.Tree (collect)
 
 import           Range

tools/lsp/squirrel/grammar/camligo/grammar.js

@@ -95,7 +95,7 @@ module.exports = grammar({
     )),
 
     _pattern: $ => choice(
-      $.Name,
+      $.var_pattern,
       $._paren_pattern,
       $.con_pattern,
       $._literal,
@@ -105,6 +105,10 @@ module.exports = grammar({
       "_"
     ),
 
+    var_pattern: $ => seq(
+      field("var", $.Name)
+    ),
+
     con_pattern: $ => prec(10,
       seq(
         field("ctor", $.data_con),

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

@@ -66,7 +66,7 @@ example :: FilePath
 -- example = "../../../src/test/contracts/lambda2.mligo"
 -- example = "../../../src/test/contracts/loop.mligo"
 -- example = "../../../src/test/contracts/let_in_multi_bind.mligo"
-example = "../../../src/test/contracts/list.mligo"
+example = "../../../src/test/contracts/fibo2.mligo"
 
 raw :: IO ()
 raw = toParseTree (Path example)
@@ -137,6 +137,7 @@ recognise = descent (\_ -> error . show . pp) $ map usingScope
         "con_pattern"      -> IsConstr <$> field  "ctor" <*> fieldOpt "args"
         "annot_pattern"    -> IsAnnot  <$> field  "pat"  <*> field "type"
         "paren_pattern"    -> IsTuple  <$> fields "pat"
+        "var_pattern"      -> IsVar    <$> field  "var"
         "_"                -> pure IsWildcard
         _                  -> fallthrough
 

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

@@ -74,7 +74,7 @@ instance {-# OVERLAPS #-} Pretty FullEnv where
       mergeFE fe = getTag @"vars" @Env fe Prelude.<> getTag @"types" fe
 
 instance Pretty ScopedDecl where
-  pp (ScopedDecl n o _ t refs doc) = color 3 (pp n) <+> pp o <+> ":" <+> color 4 (maybe "?" (either pp pp) t) <+> "=" <+> pp refs `indent` pp doc
+  pp (ScopedDecl n o _ t refs doc) = color 3 (pp n) <+> pp o <+> ":" <+> maybe "?" (either pp pp) t <+> "=" <+> pp refs `indent` pp doc
 
 instance Pretty Kind where
   pp _ = "TYPE"

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

@@ -228,6 +228,12 @@ newtype FieldName it = FieldName Text
   deriving (Show) via PP (TypeName it)
   deriving stock   (Functor, Foldable, Traversable)
 
+sexpr :: Text -> [Doc] -> Doc
+sexpr header items = "(" <.> pp header `indent` foldr above empty items <.> ")"
+
+sop :: Doc -> Text -> [Doc] -> Doc
+sop a op b = "(" <.> a `indent` pp op `indent` foldr above empty b <.> ")"
+
 instance Pretty1 Language where
   pp1 = \case
     Language _ p -> p
@@ -238,43 +244,38 @@ instance Pretty1 Undefined where
 
 instance Pretty1 Contract where
   pp1 = \case
-    ContractEnd -> "(* end *)"
+    ContractEnd -> "(endtract)"
-    ContractCons x xs -> x $$ " " $$ xs
+    ContractCons x xs -> sexpr "constract" [x, xs]
 
 instance Pretty1 RawContract where
   pp1 = \case
-    RawContract xs -> "(* begin *)" `indent` sparseBlock xs `above` "(* end *)"
+    RawContract xs -> sexpr "contract" xs
 
 instance Pretty1 Binding where
   pp1 = \case
-    Irrefutable  pat  expr     -> "irref" <+> pat  <+> "=" `indent` expr
+    Irrefutable  pat  expr     -> sexpr "irref" [pat, expr]
-    TypeDecl     n    ty       -> "type"  <+> n    <+> "=" `indent` ty
+    TypeDecl     n    ty       -> sexpr "type"  [n, ty]
-    -- TODO
+    Var          name ty value -> sexpr "var"   [name, pp ty, value]
-    Var          name ty value -> "var"   <+> name <+> ":" <+> fromMaybe "<unnanotated>" ty <+> ":=" `indent` value
+    Const        name ty body  -> sexpr "const" [name, pp ty, body]
-    Const        name ty body  -> "const" <+> name <+> ":" <+> pp ty <+>  "=" `indent` body
+    Attribute    name          -> sexpr "attr"  [name]
-    Attribute name -> "[@" <.> name <.> "]"
+    Include      fname         -> sexpr "#include" [fname]
-    Include      fname         -> "#include" <+> fname
 
     Function isRec name params ty body ->
-      (
+      sexpr "fun" $ concat
-        (
+        [ ["rec" | isRec]
-          (   (if isRec then "recursive" else empty)
+        , [name]
-          <+> "function"
+        , params
-          <+> name
+        , [":", pp ty]
-          )
+        , ["=", body]
-          `indent` pp params
+        ]
-        )
-        `indent` (":" <+> pp ty `above` "is")
-      )
-      `indent` body
 
 instance Pretty1 Parameters where
   pp1 = \case
-    Parameters them -> tuple them
+    Parameters them -> sexpr "params" them
 
 instance Pretty1 VarDecl where
   pp1 = \case
-    Decl mutability name ty -> mutability <+> name <+> ":" `indent` ty
+    Decl mutability name ty -> sexpr "decl" [mutability, name, ty]
 
 instance Pretty1 Mutable where
   pp1 = \case
@@ -283,79 +284,74 @@ instance Pretty1 Mutable where
 
 instance Pretty1 Type where
   pp1 = \case
-    TArrow    dom codom -> parens (dom `indent` "->" <+> codom)
+    TArrow    dom codom -> sop dom "->" [codom]
-    TRecord   fields    -> "record [" `indent` block fields `above` "]"
+    TRecord   fields    -> sexpr "RECORD" fields
     TVar      name      -> name
-    TSum      variants  -> block variants
+    TSum      variants  -> sexpr "SUM" variants
-    TProduct  elements  -> train " *" elements
+    TProduct  elements  -> sexpr "PROD" elements
-    TApply    f xs      -> f <+> tuple xs
+    TApply    f xs      -> sop f "$" xs
-    TTuple    xs        -> tuple xs
+    TTuple    xs        -> sexpr "TUPLE" xs
-    TOr       l n r m   -> "michelson_or"   <+> tuple [l, n, r, m]
+    TOr       l n r m   -> sexpr "OR"   [l, n, r, m]
-    TAnd      l n r m   -> "michelson_pair" <+> tuple [l, n, r, m]
+    TAnd      l n r m   -> sexpr "AND" [l, n, r, m]
 
 instance Pretty1 Variant where
   pp1 = \case
-    Variant ctor (Just ty) -> "|" <+> ctor <+> "of" `indent` ty
+    Variant ctor ty -> sexpr "ctor" [ctor, pp ty]
-    Variant ctor  _        -> "|" <+> ctor
 
 instance Pretty1 ReasonExpr where
   pp1 = \case
-    -- TODO: prettify
+    Block decls ret -> sexpr "block" $ decls ++ [pp ret]
-    Block decls ret -> "block' {"
-      `indent` block decls
-      <+> (if null decls then "" else ";")
-      `above` maybe "" ("return" `indent`) ret `above` "}"
 
 instance Pretty1 Expr where
   pp1 = \case
-    Let       decl body  -> "let" <+> decl `above` body
+    Let       decl body  -> sexpr "let" [decl, body]
-    Apply     f xs       -> "(" <.> f <.> ")" `indent` xs
+    Apply     f xs       -> sexpr "apply" [f, xs]
     Constant  constant   -> constant
     Ident     qname      -> qname
-    BinOp     l o r      -> parens (l <+> pp o <+> r)
+    BinOp     l o r      -> sop l (ppToText o) [r]
-    UnOp        o r      -> parens (pp o <+> r)
+    UnOp        o r      -> sexpr (ppToText o) [r]
     Op          o        -> pp o
-    Record    az         -> "record" <+> list az
+    Record    az         -> sexpr "record" az
-    If        b t e      -> fsep ["if" `indent` b, "then" `indent` t, "else" `indent` pp e]
+    If        b t e      -> sexpr "if" [b, t, pp e]
-    Assign    l r        -> l <+> ":=" `indent` r
+    Assign    l r        -> sop l ":=" [r]
-    List      l          -> "list" <+> list l
+    List      l          -> sexpr "list" l
-    ListAccess l ids     -> l <.> cat ((("[" <.>) . (<.> "]") . pp) <$> ids)
+    ListAccess l ids     -> sexpr "get" (l : ids)
-    Set       l          -> "set"  <+> list l
+    Set       l          -> sexpr "set" l
-    Tuple     l          -> tuple l
+    Tuple     l          -> sexpr "tuple" l
-    Annot     n t        -> parens (n <+> ":" `indent` t)
+    Annot     n t        -> sop n ":" [t]
-    Attrs     ts         -> "attributes" <+> list ts
+    Attrs     ts         -> sexpr "attrs" ts
-    BigMap    bs         -> "big_map"    <+> list bs
+    BigMap    bs         -> sexpr "big_map" bs
-    Map       bs         ->  "map"       <+> list bs
+    Map       bs         -> sexpr "map" bs
-    MapRemove k m        -> "remove" `indent` k `above` "from" <+> "map" `indent` m
+    MapRemove k m        -> sexpr "remove_map" [k, m]
-    SetRemove k s        -> "remove" `indent` k `above` "from" <+> "set" `indent` s
+    SetRemove k s        -> sexpr "remove_set" [k, s]
-    Indexing  a j        -> a <.> list [j]
+    Indexing  a j        -> sexpr "index" [a, j]
-    Case      s az       -> "case" <+> s <+> "of" `indent` block az
+    Case      s az       -> sexpr "case" (s : az)
     Skip                 -> "skip"
-    ForLoop   j s f d b  -> "for" <+> j <+> ":=" <+> s <+> "to" <+> f <+> mb ("step" <+>) d `indent` b
+    ForLoop   j s f d b  -> sexpr "for" [j, s, f, pp d, b]
-    ForBox    k mv t z b -> "for" <+> k <+> mb ("->" <+>) mv <+> "in" <+> pp t <+> z `indent` b
+    ForBox    k mv t z b -> sexpr "for_box" [k, pp mv, pp t, z, b]
-    WhileLoop f b        -> "while" <+> f `indent` b
+    WhileLoop f b        -> sexpr "while" [f, b]
-    Seq       es         -> "block {" `indent` block es `above` "}"
+    Seq       es         -> sexpr "seq" es
-    Lambda    ps ty b    -> (("lam" `indent` pp ps) `indent` (":" <+> fromMaybe "<unnanotated>" ty)) `indent` "=>" `indent` b
+    Lambda    ps ty b    -> sexpr "lam" $ concat [ps, [":", pp ty], ["=>", b]]
-    MapPatch  z bs       -> "patch" `indent` z `above` "with" <+> "map" `indent` list bs
+    MapPatch  z bs       -> sexpr "patch" (z : bs)
-    SetPatch  z bs       -> "patch" `indent` z `above` "with" <+> "set" `indent` list bs
+    SetPatch  z bs       -> sexpr "patch_set" (z : bs)
-    RecordUpd r up       -> r `indent` "with" <+> "record" `indent` list up
+    RecordUpd r up       -> sexpr "update" (r : up)
 
 instance Pretty1 Alt where
   pp1 = \case
-    Alt p b -> "|" <+> p <+> "->" `indent` b
+    Alt p b -> sexpr "alt" [p, b]
 
 instance Pretty1 MapBinding where
   pp1 = \case
-    MapBinding k v -> k <+> "->" `indent` v
+    MapBinding k v -> sexpr "bind" [k, v]
 
 instance Pretty1 Assignment where
   pp1 = \case
-    Assignment      n e -> n <+> "=" `indent` e
+    Assignment n e -> sexpr "assign" [n, e]
 
 instance Pretty1 FieldAssignment where
   pp1 = \case
-    FieldAssignment      n e -> n <+> "=" `indent` e
+    FieldAssignment n e -> sexpr ".=" [n, e]
-    Spread n -> "..." <+> n
+    Spread n -> sexpr "..." [n]
 
 instance Pretty1 Constant where
   pp1 = \case
@@ -368,34 +364,34 @@ instance Pretty1 Constant where
 
 instance Pretty1 QualifiedName where
   pp1 = \case
-    QualifiedName src path -> src <.> sepByDot path
+    QualifiedName src path -> sexpr "." (src : path)
 
 instance Pretty1 Pattern where
   pp1 = \case
-    IsConstr     ctor arg  -> ctor <+> maybe empty id arg
+    IsConstr     ctor arg  -> sexpr "ctor?" [ctor, pp arg]
-    IsConstant   z         -> z
+    IsConstant   z         -> sexpr "is?" [z]
-    IsVar        name      -> name
+    IsVar        name      -> sexpr "?" [name]
-    IsCons       h t       -> h <+> ("#" <+> t)
+    IsCons       h t       -> sop h "::?" [t]
-    IsAnnot      s t       -> "(" <+> s <+> ":" <+> t <+> ")"
+    IsAnnot      s t       -> sexpr "type?" [s, t]
-    IsWildcard             -> "_"
+    IsWildcard             -> "_?"
-    IsList       l         -> list l
+    IsList       l         -> sexpr "list?" l
-    IsTuple      t         -> tuple t
+    IsTuple      t         -> sexpr "tuple?" t
 
 instance Pretty1 Name where
   pp1 = \case
-    Name         raw -> pp raw
+    Name         raw -> color 2 $ pp raw
 
 instance Pretty1 TypeName where
   pp1 = \case
-    TypeName     raw -> pp raw
+    TypeName     raw -> color 3 $ pp raw
 
 instance Pretty1 FieldName where
   pp1 = \case
-    FieldName    raw -> pp raw
+    FieldName    raw -> color 4 $ pp raw
 
 instance Pretty1 Ctor where
   pp1 = \case
-    Ctor         raw -> pp raw
+    Ctor         raw -> color 5 $ pp raw
 
 instance Pretty1 Path where
   pp1 = \case