Separate the namespaces for search

src/test/contracts/heap.ligo

@@ -54,7 +54,7 @@ function insert (const h : heap ; const e : heap_elt) : heap is
       parent := i/2n;
       largest := i;
       if parent >= 1n then {
-        if heap_elt_lt (get_force (parent,h), get_force(i,h))) then {
+        if heap_elt_lt (get_force (parent,h), get_force(i,h)) then {
           largest := parent;
           const tmp : heap_elt = get_force (i,h);
           h[i] := get_force(parent, h);

src/test/contracts/namespaces.ligo

@@ -0,0 +1,10 @@
+
+type cards is record
+  cards : cards
+end
+
+const cards : cards = record [cards = cards]
+
+const cards : cards = cards with record [cards = cards]
+
+const cards : cards = cards.cards

tools/lsp/pascaligo/grammar.js

@@ -75,7 +75,7 @@ module.exports = grammar({
     type_decl: $ =>
       seq(
         "type",
-        field("typeName", $.Name),
+        field("typeName", $.TypeName),
         "is",
         field("typeValue", $._type_expr),
       ),
@@ -109,14 +109,14 @@ module.exports = grammar({
 
     _core_type: $ =>
       choice(
-        $.Name,
+        $.TypeName,
         $.invokeBinary,
         $.invokeUnary,
       ),
 
     invokeBinary: $ =>
       seq(
-        field("typeConstr", choice('map', 'big_map', $.Name)),
+        field("typeConstr", choice('map', 'big_map', $.TypeName)),
         field("arguments", $.type_tuple),
       ),
 
@@ -159,7 +159,7 @@ module.exports = grammar({
 
     field_decl: $ =>
       seq(
-        field("fieldName", $.Name),
+        field("fieldName", $.FieldName),
         ':',
         field("fieldType", $._type_expr),
       ),
@@ -575,6 +575,8 @@ module.exports = grammar({
 
     path: $ => choice($.Name, $._projection),
 
+    fpath: $ => choice($.FieldName, $._projection),
+
     module_field: $ =>
       seq(
         field("module", $.Name_Capital),
@@ -616,7 +618,7 @@ module.exports = grammar({
         sepBy1('.', field("index", $.selection)),
       ),
 
-    selection: $ => choice($.Name, $.Int),
+    selection: $ => choice($.FieldName, $.Int),
 
     record_expr: $ =>
       choice(
@@ -642,14 +644,14 @@ module.exports = grammar({
 
     field_assignment: $ =>
       seq(
-        field("name", $.Name),
+        field("name", $.FieldName),
         '=',
         field("_rhs", $._expr),
       ),
 
     field_path_assignment: $ =>
       seq(
-        field("lhs", $.path),
+        field("lhs", $.fpath),
         '=',
         field("_rhs", $._expr),
       ),
@@ -747,6 +749,8 @@ module.exports = grammar({
     Nat:          $ => /([1-9][0-9_]*|0)n/,
     Tez:          $ => /([1-9][0-9_]*|0)(\.[0-9_]+)?(tz|tez|mutez)/,
     Bytes:        $ => /0x[0-9a-fA-F]+/,
+    FieldName:    $ => /[a-z][a-zA-Z0-9_]*/,
+    TypeName:     $ => /[a-z][a-zA-Z0-9_]*/,
     Name:         $ => /[a-z][a-zA-Z0-9_]*/,
     Name_Capital: $ => /[A-Z][a-zA-Z0-9_]*/,
     Keyword:      $ => /[A-Za-z][a-z]*/,

tools/lsp/squirrel/app/Main.hs

@@ -198,7 +198,7 @@ rangeToLoc (Range (a, b, _) (c, d, _) _) =
 loadFromVFS
   :: Core.LspFuncs ()
   -> J.Uri
-  -> IO (Pascal (Product [[ScopedDecl], Range, [Text]]))
+  -> IO (Pascal (Product [[ScopedDecl], Maybe Category, Range, [Text]]))
 loadFromVFS funs uri = do
   Just vf <- Core.getVirtualFileFunc funs $ J.toNormalizedUri uri
   let txt = virtualFileText vf
@@ -206,7 +206,9 @@ loadFromVFS funs uri = do
   (tree, _) <- runParser contract (Text fin txt)
   return $ addLocalScopes tree
 
-loadByURI :: J.Uri -> IO (Pascal (Product [[ScopedDecl], Range, [Text]]))
+loadByURI
+  :: J.Uri
+  -> IO (Pascal (Product [[ScopedDecl], Maybe Category, Range, [Text]]))
 loadByURI uri = do
   case J.uriToFilePath uri of
     Just fin -> do

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

@@ -12,56 +12,67 @@ import Tree
 import Range
 import Lattice
 import Pretty
+import Product
 
 import Debug.Trace
 
 findScopedDecl
-  :: ( HasLocalScope info
+  :: ( Contains [ScopedDecl] xs
-     , HasRange info
+     , Contains Range xs
+     , Contains (Maybe Category) xs
      )
   => Range
-  -> Pascal info
+  -> Pascal (Product xs)
   -> Maybe ScopedDecl
 findScopedDecl pos tree = do
   point <- lookupTree pos tree
-  lookupEnv (ppToText $ void point) (getLocalScope (infoOf point))
+  let info = infoOf point
+  let fullEnv = getElem info
+  do
+    cat <- getElem info
+    let filtered = filter (ofCategory cat) fullEnv
+    lookupEnv (ppToText $ void point) filtered
 
 definitionOf
-  :: ( HasLocalScope info
+  :: ( Contains [ScopedDecl] xs
-     , HasRange info
+     , Contains Range xs
+     , Contains (Maybe Category) xs
      )
   => Range
-  -> Pascal info
+  -> Pascal (Product xs)
   -> Maybe Range
 definitionOf pos tree =
   _sdOrigin <$> findScopedDecl pos tree
 
 typeOf
-  :: ( HasLocalScope info
+  :: ( Contains [ScopedDecl] xs
-     , HasRange info
+     , Contains Range xs
+     , Contains (Maybe Category) xs
      )
   => Range
-  -> Pascal info
+  -> Pascal (Product xs)
   -> Maybe (Either (Pascal ()) Kind)
 typeOf pos tree =
   _sdType =<< findScopedDecl pos tree
 
 implementationOf
-  :: ( HasLocalScope info
+  :: ( Contains [ScopedDecl] xs
-     , HasRange info
+     , Contains Range xs
+     , Contains (Maybe Category) xs
      )
   => Range
-  -> Pascal info
+  -> Pascal (Product xs)
   -> Maybe Range
 implementationOf pos tree =
   _sdBody =<< findScopedDecl pos tree
 
 referencesOf
-  :: ( HasLocalScope info
+  :: ( Contains [ScopedDecl] xs
-     , HasRange info
+     , Contains Range xs
+     , Contains (Maybe Category) xs
      )
   => Range
-  -> Pascal info
+  -> Pascal (Product xs)
   -> Maybe [Range]
 referencesOf pos tree =
   _sdRefs <$> findScopedDecl pos tree

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

@@ -39,6 +39,12 @@ contract =
 name :: Parser (Pascal ASTInfo)
 name = ranged do pure Name <*> token "Name"
 
+typeName :: Parser (Pascal ASTInfo)
+typeName = ranged do pure TypeName <*> token "TypeName"
+
+fieldName :: Parser (Pascal ASTInfo)
+fieldName = ranged do pure FieldName <*> token "FieldName"
+
 capitalName :: Parser (Pascal ASTInfo)
 capitalName = ranged do pure Name <*> token "Name_Capital"
 
@@ -65,7 +71,7 @@ typedecl = do
   subtree "type_decl" do
     ranged do
       pure TypeDecl
-        <*> inside "typeName:"  name
+        <*> inside "typeName:"  typeName
         <*> inside "typeValue:" newtype_
 
 vardecl :: Parser (Pascal ASTInfo)
@@ -185,7 +191,7 @@ field_path_assignment = do
   subtree "field_path_assignment" do
     ranged do
       pure FieldAssignment
-        <*> inside "lhs:path" do qname <|> projection
+        <*> inside "lhs:fpath" do fqname <|> projection
         <*> inside "_rhs" expr
 
 map_patch :: Parser (Pascal ASTInfo)
@@ -556,6 +562,13 @@ qname = do
       <*> name
       <*> pure []
 
+fqname :: Parser (Pascal ASTInfo)
+fqname = do
+  ranged do
+    pure QualifiedName
+      <*> fieldName
+      <*> pure []
+
 qname' :: Parser (Pascal ASTInfo)
 qname' = do
   ranged do
@@ -640,7 +653,7 @@ projection = do
 selection :: Parser (Pascal ASTInfo)
 selection = do
     inside "index:selection"
-      $   ranged do pure At <*> name
+      $   ranged do pure At <*> fieldName
       <|> ranged do pure Ix <*> token "Int"
   <|>
     inside "index" do
@@ -677,7 +690,7 @@ record_expr = do
         inside "assignment:field_assignment" do
           ranged do
             pure Assignment
-              <*> inside "name" name
+              <*> inside "name" fieldName
               <*> inside "_rhs" expr
 
 fun_call :: Parser (Pascal ASTInfo)
@@ -789,7 +802,7 @@ field_decl = do
   subtree "field_decl" do
     ranged do
       pure TField
-        <*> inside "fieldName" name
+        <*> inside "fieldName" fieldName
         <*> inside "fieldType" newtype_
 
 type_ :: Parser (Pascal ASTInfo)
@@ -819,7 +832,7 @@ type_ =
 
     core_type = do
       select
-        [ ranged do pure TVar <*> name
+        [ ranged do pure TVar <*> typeName
         , subtree "invokeBinary" do
             ranged do
               pure TApply
@@ -849,7 +862,7 @@ typeTuple = do
 -- example = "../../../src/test/contracts/amount.ligo"
 -- example = "../../../src/test/contracts/annotation.ligo"
 -- example = "../../../src/test/contracts/arithmetic.ligo"
-example = "../../../src/test/contracts/assign.ligo"
+-- example = "../../../src/test/contracts/assign.ligo"
 -- example = "../../../src/test/contracts/attributes.ligo"
 -- example = "../../../src/test/contracts/bad_timestamp.ligo"
 -- example = "../../../src/test/contracts/bad_type_operator.ligo"
@@ -866,7 +879,7 @@ example = "../../../src/test/contracts/assign.ligo"
 -- example = "../../../src/test/contracts/loop.ligo"
 -- example = "../../../src/test/contracts/redeclaration.ligo"
 -- example = "../../../src/test/contracts/includer.ligo"
--- example = "../../../src/test/contracts/application.ligo"
+example = "../../../src/test/contracts/namespaces.ligo"
 -- example = "../../../src/test/contracts/application.ligo"
 -- example = "../../../src/test/contracts/application.ligo"
 -- example = "../../../src/test/contracts/application.ligo"

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

@@ -48,32 +48,81 @@ type CollectM = State (Product [FullEnv, [Range]])
 
 type AddRefsM = State FullEnv
 
-type FullEnv = Map Range [ScopedDecl]
+data FullEnv = FullEnv
+  { vars   :: Env
+  , types  :: Env
+  }
+
+data Category = Variable | Type
+
+emptyEnv = FullEnv Map.empty Map.empty
+
+with Variable (FullEnv vs ts) f = FullEnv (f vs) ts
+with Type     (FullEnv vs ts) f = FullEnv vs (f ts)
+
+grab Variable (FullEnv vs ts) = vs
+grab Type     (FullEnv vs ts) = ts
+
+type Env = Map Range [ScopedDecl]
+
+ofCategory Variable ScopedDecl { _sdType = Just (Right Star) } = False
+ofCategory Variable _                                          = True
+ofCategory Type     ScopedDecl { _sdType = Just (Right Star) } = True
+ofCategory _        _                                          = False
 
 -- | Calculate scopes and attach to all tree points declarations that are
 --   visible there.
 --
 addLocalScopes
-  :: HasRange (Product xs)
+  :: Contains Range xs
   => Pascal (Product xs)
-  -> Pascal (Product ([ScopedDecl] : xs))
+  -> Pascal (Product ([ScopedDecl] : Maybe Category : xs))
 addLocalScopes tree =
-    fmap (\xs -> Cons (envAt envWithREfs $ getRange xs) xs) tree
+    fmap (\xs -> Cons (fullEnvAt envWithREfs (getRange xs)) xs) tree1
   where
+    tree1       = addNameCategories tree
     envWithREfs = getEnvTree tree
 
+addNameCategories
+  :: Contains Range xs
+  => Pascal (Product xs)
+  -> Pascal (Product (Maybe Category : xs))
+addNameCategories tree = flip evalState emptyEnv do
+  traverseMany
+    [ Visit \r (Name t) -> do
+        modify $ getRange r `addRef` (Variable, t)
+        return $ (Cons (Just Variable) r, Name t)
+
+    , Visit \r (TypeName t) -> do
+        modify $ getRange r `addRef` (Type, t)
+        return $ (Cons (Just Type) r, TypeName t)
+    ]
+    (Cons Nothing)
+    tree
+
 getEnvTree tree = envWithREfs
   where
     envWithREfs = flip execState env do
-      flip traverseOnly tree \r (Name t) -> do
+      traverseMany
-        modify $ getRange r `addRef` t
+        [ Visit \r (Name t) -> do
-        return $ Name t
+            modify $ getRange r `addRef` (Variable, t)
+            return $ (r, Name t)
+
+        , Visit \r (TypeName t) -> do
+            modify $ getRange r `addRef` (Type, t)
+            return $ (r, TypeName t)
+        ]
+        id
+        tree
 
     env
       = execCollectM
       $ traverseTree pure tree
 
-envAt :: FullEnv -> Range -> [ScopedDecl]
+fullEnvAt :: FullEnv -> Range -> [ScopedDecl]
+fullEnvAt fe r = envAt (grab Type fe) r <> envAt (grab Variable fe) r
+
+envAt :: Env -> Range -> [ScopedDecl]
 envAt env pos =
     Map.elems scopes
   where
@@ -83,21 +132,25 @@ envAt env pos =
     isCovering = (pos <?)
     toScopeMap sd@ScopedDecl {_sdName} = Map.singleton (ppToText _sdName) sd
 
-addRef :: Range -> Text -> FullEnv -> FullEnv
+addRef :: Range -> (Category, Text) -> FullEnv -> FullEnv
-addRef r n env = Map.union (go range) env
+addRef r (cat, n) env =
+  with cat env \slice ->
+    Map.union
+      (go slice $ range slice)
+      slice
   where
-    go (r' : rest) =
+    go slice (r' : rest) =
-      let decls = env Map.! r'
+      let decls = slice Map.! r'
       in
         case updateOnly n r addRefToDecl decls of
           (True,  decls) -> Map.singleton r' decls
-          (False, decls) -> Map.insert r' decls (go rest)
+          (False, decls) -> Map.insert r' decls (go slice rest)
-    go [] = Map.empty
+    go _ [] = Map.empty
 
-    range
+    range slice
       = List.sortBy partOrder
       $ filter (r <?)
-      $ Map.keys env
+      $ Map.keys slice
 
     addRefToDecl sd = sd
       { _sdRefs = r : _sdRefs sd
@@ -125,11 +178,12 @@ enter :: Range -> CollectM ()
 enter r = do
   modify $ modElem (r :)
 
-define :: ScopedDecl -> CollectM ()
+define :: Category -> ScopedDecl -> CollectM ()
-define sd = do
+define cat sd = do
   r <- gets (head . getElem)
   modify
-    $ modElem @FullEnv
+    $ modElem @FullEnv \env ->
+        with cat env
         $ Map.insertWith (++) r [sd]
 
 leave :: CollectM ()
@@ -137,13 +191,15 @@ leave = modify $ modElem @[Range] tail
 
 -- | Run the computation with scope starting from empty scope.
 execCollectM :: CollectM a -> FullEnv
-execCollectM action = getElem $ execState action $ Cons Map.empty (Cons [] Nil)
+execCollectM action = getElem $ execState action $ Cons emptyEnv (Cons [] Nil)
 
 instance {-# OVERLAPS #-} Pretty FullEnv where
-  pp = block . map aux .  Map.toList
+  pp = block . map aux . Map.toList . mergeFE
     where
-      aux (r, decls) =
+      aux (r, fe) =
-        pp r `indent` block decls
+        pp r `indent` block fe
+
+      mergeFE (FullEnv a b) = a <> b
 
 -- | The type/value declaration.
 data ScopedDecl = ScopedDecl
@@ -172,7 +228,7 @@ lookupEnv name = listToMaybe . filter ((name ==) . ppToText . _sdName)
 -- | Add a type declaration to the current scope.
 defType :: HasRange a => Pascal a -> Kind -> Pascal a -> CollectM ()
 defType name kind body = do
-  define
+  define Type
     $ ScopedDecl
       (void name)
       (getRange $ infoOf name)
@@ -194,7 +250,7 @@ def
   -> Maybe (Pascal a)
   -> CollectM ()
 def name ty body = do
-  define
+  define Variable
     $ ScopedDecl
       (void name)
       (getRange $ infoOf name)
@@ -276,4 +332,6 @@ instance HasRange a => UpdateOver CollectM Pattern (Pascal a) where
 
 instance UpdateOver CollectM QualifiedName (Pascal a)
 instance UpdateOver CollectM Path          (Pascal a)
-instance UpdateOver CollectM Name          (Pascal a) where
+instance UpdateOver CollectM Name          (Pascal a)
+instance UpdateOver CollectM TypeName      (Pascal a)
+instance UpdateOver CollectM FieldName     (Pascal a)

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

@@ -20,7 +20,7 @@ import Tree
 type Pascal = Tree
   [ Name, Path, QualifiedName, Pattern, Constant, FieldAssignment, Assignment
   , MapBinding, LHS, Alt, Expr, TField, Variant, Type, Mutable, VarDecl, Binding
-  , Declaration, Contract
+  , Declaration, Contract, TypeName, FieldName
   ]
 
 data Contract it
@@ -170,12 +170,20 @@ data Path it
   deriving (Show) via PP (Path it)
   deriving stock (Functor, Foldable, Traversable)
 
-data Name it = Name
+newtype Name it = Name
   { _raw     :: Text
   }
   deriving (Show) via PP (Name it)
   deriving stock (Functor, Foldable, Traversable)
 
+newtype TypeName it = TypeName Text
+  deriving (Show) via PP (TypeName it)
+  deriving stock   (Functor, Foldable, Traversable)
+
+newtype FieldName it = FieldName Text
+  deriving (Show) via PP (TypeName it)
+  deriving stock   (Functor, Foldable, Traversable)
+
 instance Pretty1 Contract where
   pp1 = \case
     Contract decls ->
@@ -309,6 +317,14 @@ instance Pretty1 Name where
   pp1 = \case
     Name         raw -> pp raw
 
+instance Pretty1 TypeName where
+  pp1 = \case
+    TypeName     raw -> pp raw
+
+instance Pretty1 FieldName where
+  pp1 = \case
+    FieldName    raw -> pp raw
+
 instance Pretty1 Path where
   pp1 = \case
     At n -> n

tools/lsp/squirrel/src/Tree.hs

@@ -181,11 +181,11 @@ traverseOnly act = go
 
     go tree = pure tree
 
-data Visit fs a m where
+data Visit fs a b m where
   Visit
     :: (Element f fs, Traversable f)
-    => (a -> f (Tree fs a) -> m (f (Tree fs a)))
+    => (a -> f (Tree fs a) -> m (b, f (Tree fs a)))
-    -> Visit fs a m
+    -> Visit fs a b m
 
 traverseMany
   :: ( Apply Functor fs
@@ -193,26 +193,27 @@ traverseMany
      , Apply Traversable fs
      , Monad m
      )
-  => [Visit fs a m]
+  => [Visit fs a b m]
+  -> (a -> b)
   -> Tree fs a
-  -> m (Tree fs a)
+  -> m (Tree fs b)
-traverseMany visitors = go
+traverseMany visitors orElse = go
   where
     go tree = aux visitors
       where
         aux (Visit visitor : rest) = do
           case match tree of
             Just (r, fa) -> do
-              fa'  <- visitor r fa
+              (r', fa')  <- visitor r fa
               fa'' <- traverse go fa'
-              return $ mk r fa''
+              return $ mk r' fa''
             Nothing -> do
               aux rest
         aux [] = do
           case tree of
             Tree (Right (r, union)) -> do
               union' <- traverse go union
-              return $ Tree (Right (r, union'))
+              return $ Tree (Right (orElse r, union'))
 
 -- | Make a tree out of a layer and an info.
 mk :: (Functor f, Element f fs) => info -> f (Tree fs info) -> Tree fs info