From c26bc044eec0545ab6215ab65efbb3fb34c8373d Mon Sep 17 00:00:00 2001 From: Kirill Andreev Date: Wed, 8 Jul 2020 20:31:42 +0400 Subject: [PATCH] Separate the namespaces for search --- src/test/contracts/heap.ligo | 2 +- src/test/contracts/namespaces.ligo | 10 +++ tools/lsp/pascaligo/grammar.js | 18 +++-- tools/lsp/squirrel/app/Main.hs | 6 +- tools/lsp/squirrel/src/AST/Find.hs | 43 ++++++---- tools/lsp/squirrel/src/AST/Parser.hs | 29 +++++-- tools/lsp/squirrel/src/AST/Scope.hs | 112 ++++++++++++++++++++------- tools/lsp/squirrel/src/AST/Types.hs | 22 +++++- tools/lsp/squirrel/src/Tree.hs | 19 ++--- 9 files changed, 188 insertions(+), 73 deletions(-) create mode 100644 src/test/contracts/namespaces.ligo diff --git a/src/test/contracts/heap.ligo b/src/test/contracts/heap.ligo index 9ff8f8154..64667a600 100644 --- a/src/test/contracts/heap.ligo +++ b/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); diff --git a/src/test/contracts/namespaces.ligo b/src/test/contracts/namespaces.ligo new file mode 100644 index 000000000..2070d1d94 --- /dev/null +++ b/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 diff --git a/tools/lsp/pascaligo/grammar.js b/tools/lsp/pascaligo/grammar.js index 602dbe5e1..3fe3a1f12 100644 --- a/tools/lsp/pascaligo/grammar.js +++ b/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]*/, diff --git a/tools/lsp/squirrel/app/Main.hs b/tools/lsp/squirrel/app/Main.hs index 6358849bc..92beb87c4 100644 --- a/tools/lsp/squirrel/app/Main.hs +++ b/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 diff --git a/tools/lsp/squirrel/src/AST/Find.hs b/tools/lsp/squirrel/src/AST/Find.hs index 9fbe06d6e..5bf449178 100644 --- a/tools/lsp/squirrel/src/AST/Find.hs +++ b/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 - , HasRange info + :: ( Contains [ScopedDecl] xs + , 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 - , HasRange info + :: ( Contains [ScopedDecl] xs + , 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 - , HasRange info + :: ( Contains [ScopedDecl] xs + , 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 - , HasRange info + :: ( Contains [ScopedDecl] xs + , 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 - , HasRange info + :: ( Contains [ScopedDecl] xs + , Contains Range xs + , Contains (Maybe Category) xs ) => Range - -> Pascal info + -> Pascal (Product xs) -> Maybe [Range] referencesOf pos tree = _sdRefs <$> findScopedDecl pos tree diff --git a/tools/lsp/squirrel/src/AST/Parser.hs b/tools/lsp/squirrel/src/AST/Parser.hs index 7c9628dfc..8dc50c807 100644 --- a/tools/lsp/squirrel/src/AST/Parser.hs +++ b/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" diff --git a/tools/lsp/squirrel/src/AST/Scope.hs b/tools/lsp/squirrel/src/AST/Scope.hs index 0ce1c7767..920760736 100644 --- a/tools/lsp/squirrel/src/AST/Scope.hs +++ b/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 - modify $ getRange r `addRef` t - return $ Name t + traverseMany + [ Visit \r (Name t) -> do + 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 Text -> FullEnv -> FullEnv -addRef r n env = Map.union (go range) env +addRef :: Range -> (Category, Text) -> FullEnv -> FullEnv +addRef r (cat, n) env = + with cat env \slice -> + Map.union + (go slice $ range slice) + slice where - go (r' : rest) = - let decls = env Map.! r' + go slice (r' : rest) = + 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) - go [] = Map.empty + (False, decls) -> Map.insert r' decls (go slice rest) + go _ [] = Map.empty - range + range slice = List.sortBy partOrder $ filter (r CollectM () enter r = do modify $ modElem (r :) -define :: ScopedDecl -> CollectM () -define sd = do +define :: Category -> ScopedDecl -> CollectM () +define cat sd = do r <- gets (head . getElem) modify - $ modElem @FullEnv - $ Map.insertWith (++) r [sd] + $ modElem @FullEnv \env -> + with cat env + $ Map.insertWith (++) r [sd] leave :: CollectM () 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) = - pp r `indent` block decls + aux (r, fe) = + 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) diff --git a/tools/lsp/squirrel/src/AST/Types.hs b/tools/lsp/squirrel/src/AST/Types.hs index 2272d767b..169d87bf1 100644 --- a/tools/lsp/squirrel/src/AST/Types.hs +++ b/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 -> @@ -307,7 +315,15 @@ instance Pretty1 Pattern where instance Pretty1 Name where pp1 = \case - Name raw -> pp raw + 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 diff --git a/tools/lsp/squirrel/src/Tree.hs b/tools/lsp/squirrel/src/Tree.hs index 4d744a0c2..02f71058e 100644 --- a/tools/lsp/squirrel/src/Tree.hs +++ b/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))) - -> Visit fs a m + => (a -> f (Tree fs a) -> m (b, f (Tree fs a))) + -> 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) -traverseMany visitors = go + -> m (Tree fs b) +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