Separate the namespaces for search

This commit is contained in:
Kirill Andreev 2020-07-08 20:31:42 +04:00
parent ba3c0a76d9
commit c26bc044ee
No known key found for this signature in database
GPG Key ID: CF7DA79DE4785A47
9 changed files with 188 additions and 73 deletions

View File

@ -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);

View File

@ -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

View File

@ -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]*/,

View File

@ -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

View File

@ -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

View File

@ -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"

View File

@ -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 <?)
toScopeMap sd@ScopedDecl {_sdName} = Map.singleton (ppToText _sdName) sd
addRef :: Range -> 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 <?)
$ Map.keys env
$ Map.keys slice
addRefToDecl sd = sd
{ _sdRefs = r : _sdRefs sd
@ -125,25 +178,28 @@ enter :: Range -> 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)

View File

@ -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

View File

@ -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