Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Cloogle
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
Operations
Operations
Incidents
Analytics
Analytics
Repository
Value Stream
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Commits
Issue Boards
Open sidebar
Cloogle
Cloogle
Commits
7c5e0a80
Verified
Commit
7c5e0a80
authored
Feb 03, 2018
by
Camil Staps
🚀
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Implement function usages
parent
7bd21048
Changes
10
Hide whitespace changes
Inline
Side-by-side
Showing
10 changed files
with
282 additions
and
276 deletions
+282
-276
AllIdents.dcl
AllIdents.dcl
+0
-26
AllIdents.icl
AllIdents.icl
+0
-190
CleanPrettyPrint
CleanPrettyPrint
+1
-1
CleanTypeUnifier
CleanTypeUnifier
+1
-1
CloogleDBFactory.dcl
CloogleDBFactory.dcl
+7
-5
CloogleDBFactory.icl
CloogleDBFactory.icl
+71
-44
DB.dcl
DB.dcl
+1
-1
DB.icl
DB.icl
+10
-8
Idents.dcl
Idents.dcl
+23
-0
Idents.icl
Idents.icl
+168
-0
No files found.
AllIdents.dcl
deleted
100644 → 0
View file @
7bd21048
definition
module
AllIdents
from
StdClass
import
class
Eq
from
StdList
import
isMember
,
removeDup
from
StdOverloaded
import
class
==
from
syntax
import
::
ParsedDefinition
class
AllIdents
t
where
// allIdents` :: t -> [String]
// allIdents :: t -> [String]
// allIdents x :== removeDup (allIdents` x)
definedIdents`
::
t
->
[
String
]
definedIdents
::
t
->
[
String
]
definedIdents
x
:==
removeDup
(
definedIdents`
x
)
globalIdents`
::
t
->
[
String
]
globalIdents
::
t
->
[
String
]
|
AllIdents
t
globalIdents
x
:==
removeDup
(
globalIdents`
x
)
instance
AllIdents
[
t
]
|
AllIdents
t
instance
AllIdents
ParsedDefinition
AllIdents.icl
deleted
100644 → 0
View file @
7bd21048
implementation
module
AllIdents
from
Data
.
List
import
concatMap
import
syntax
instance
AllIdents
[
t
]
|
AllIdents
t
where
globalIdents`
xs
=
concatMap
globalIdents`
xs
definedIdents`
xs
=
concatMap
definedIdents`
xs
instance
AllIdents
ParsedDefinition
where
globalIdents`
pd
=
case
pd
of
PD_Function
_
id
_
args
rhs
_
->
[
i
\\
i
<-
globalIdents
rhs
++
globalIdents
|
not
(
isMember
i
[
id
.
id_name
:
globalIdents
args
])]
PD_NodeDef
_
e
rhs
->
[
i
\\
i
<-
globalIdents
rhs
|
not
(
isMember
i
(
globalIdents
e
))]
PD_Type
ptd
->
abort
"AllIdents PD_Type
\n
"
PD_TypeSpec
_
_
_
_
_
->
[]
//PD_TypeSpec Position Ident Priority (Optional SymbolType) FunSpecials
//PD_Class ClassDef [ParsedDefinition]
//PD_Instance ParsedInstanceAndMembers
//PD_Instances [ParsedInstanceAndMembers]
//PD_Import [ParsedImport]
//PD_ImportedObjects [ImportedObject]
//PD_ForeignExport !Ident !{#Char} !Int !Bool /* if stdcall */
//PD_Generic GenericDef
//PD_GenericCase GenericCaseDef Ident
//PD_Derive [GenericCaseDef]
//PD_Documentation DocType String
//PD_Erroneous
_
->
abort
"AllIdents ParsedDefinition
\n
"
definedIdents`
pd
=
case
pd
of
PD_Function
_
id
_
_
_
_
->
[
id
.
id_name
]
PD_NodeDef
_
e
_
->
globalIdents`
e
PD_TypeSpec
_
_
_
_
_
->
[]
// TODO
instance
AllIdents
ParsedExpr
where
globalIdents`
pe
=
case
pe
of
PE_List
pes
->
globalIdents`
pes
PE_Ident
id
->
[
id
.
id_name
]
PE_Basic
_
->
[]
PE_Bound
e
->
[]
PE_Lambda
_
args
rhs
_
->
[
i
\\
i
<-
globalIdents
rhs
|
not
(
isMember
i
(
globalIdents
args
))]
PE_Tuple
es
->
globalIdents`
es
PE_Record
init
_
fields
->
globalIdents`
init
++
globalIdents`
[
f
.
bind_src
\\
f
<-
fields
]
//(PE_Record !ParsedExpr !OptionalRecordName ![FieldAssignment]
PE_ArrayPattern
_
->
abort
"AllIdents PE_ArrayPattern"
//(PE_ArrayPattern ![ElemAssignment]
PE_UpdateComprehension
_
_
_
_
->
abort
"AllIdents PE_UpdateComprehension"
//(PE_UpdateComprehension !ParsedExpr !ParsedExpr !ParsedExpr ![Qualifier]
PE_ArrayDenot
_
_
->
abort
"AllIdents PE_ArrayDenot"
//(PE_ArrayDenot !ArrayKind ![ParsedExpr]
PE_Selection
_
e
s
->
globalIdents`
e
++
globalIdents`
s
PE_Update
_
_
_
->
abort
"AllIdents PE_Update"
//(PE_Update !ParsedExpr [ParsedSelection] ParsedExpr
PE_Case
_
pe
alts
->
globalIdents`
pe
++
globalIdents`
alts
PE_If
_
b
t
e
->
globalIdents`
[
b
,
t
,
e
]
//(PE_If !Ident !ParsedExpr !ParsedExpr !ParsedExpr
PE_Let
locals
e
->
globalIdents`
locals
++
globalIdents`
e
PE_ListCompr
_
_
e
qs
->
[
i
\\
i
<-
globalIdents
e
++
globalIdents
qs
|
not
(
isMember
i
(
definedIdents
qs
))]
PE_ArrayCompr
_
e
qs
->
[
i
\\
i
<-
globalIdents
e
++
globalIdents
qs
|
not
(
isMember
i
(
definedIdents
qs
))]
//(PE_ArrayCompr !ArrayKind !ParsedExpr ![Qualifier]
PE_Sequ
s
->
globalIdents`
s
PE_WildCard
->
[]
PE_Matches
_
_
_
_
->
abort
"AllIdents PE_Matches"
//(PE_Matches !Ident /*expr*/!ParsedExpr /*pattern*/!ParsedExpr !Position
//(PE_QualifiedIdent !Ident !String
PE_ABC_Code
_
_
->
[]
PE_Any_Code
_
_
_
->
[]
//(PE_DynamicPattern !ParsedExpr !DynamicType
//(PE_Dynamic !ParsedExpr !(Optional DynamicType)
//(PE_Generic !Ident !TypeKind /* AA: For generics, kind indexed identifier */
//(PE_TypeSignature !ArrayKind !ParsedExpr
PE_Empty
->
[]
_
->
abort
"AllIdents ParsedExpr
\n
"
definedIdents`
pe
=
case
pe
of
(
PE_List
pes
)
->
[]
(
PE_Ident
id
)
->
[]
(
PE_Basic
_)
->
[]
(
PE_Bound
e
)
->
[
e
.
bind_dst
.
id_name
:
globalIdents`
e
.
bind_src
]
(
PE_Lambda
_
_
_
_)
->
[]
(
PE_Tuple
_)
->
[]
(
PE_Record
_
_
_)
->
[]
(
PE_ArrayPattern
_)
->
abort
"AllIdents PE_ArrayPattern"
//(PE_ArrayPattern ![ElemAssignment]
(
PE_UpdateComprehension
_
_
_
_)
->
abort
"AllIdents PE_UpdateComprehension"
//(PE_UpdateComprehension !ParsedExpr !ParsedExpr !ParsedExpr ![Qualifier]
(
PE_ArrayDenot
_
_)
->
abort
"AllIdents PE_ArrayDenot"
//(PE_ArrayDenot !ArrayKind ![ParsedExpr]
(
PE_Selection
_
_
_)
->
abort
"AllIdents PE_Selection"
//(PE_Selection !ParsedSelectorKind !ParsedExpr ![ParsedSelection]
(
PE_Update
_
_
_)
->
abort
"AllIdents PE_Update"
//(PE_Update !ParsedExpr [ParsedSelection] ParsedExpr
(
PE_Case
_
pe
alts
)
->
globalIdents`
pe
++
globalIdents`
alts
(
PE_If
_
b
t
e
)
->
globalIdents`
[
b
,
t
,
e
]
//(PE_If !Ident !ParsedExpr !ParsedExpr !ParsedExpr
(
PE_Let
locals
e
)
->
globalIdents`
locals
++
globalIdents`
e
(
PE_ListCompr
_
_
e
qs
)
->
[
i
\\
i
<-
globalIdents
e
|
not
(
isMember
i
(
globalIdents
qs
))]
//(PE_ArrayCompr !ArrayKind !ParsedExpr ![Qualifier]
//(PE_Sequ Sequence
PE_WildCard
->
[]
//(PE_Matches !Ident /*expr*/!ParsedExpr /*pattern*/!ParsedExpr !Position
//(PE_QualifiedIdent !Ident !String
//(PE_ABC_Code ![String] !Bool
//(PE_Any_Code !(CodeBinding Ident) !(CodeBinding Ident) ![String]
//(PE_DynamicPattern !ParsedExpr !DynamicType
//(PE_Dynamic !ParsedExpr !(Optional DynamicType)
//(PE_Generic !Ident !TypeKind /* AA: For generics, kind indexed identifier */
//(PE_TypeSignature !ArrayKind !ParsedExpr
PE_Empty
->
[]
_
->
abort
"AllIdents ParsedExpr
\n
"
instance
AllIdents
(
Optional
a
)
|
AllIdents
a
where
globalIdents`
No
=
[]
globalIdents`
(
Yes
x
)
=
globalIdents`
x
definedIdents`
No
=
[]
definedIdents`
(
Yes
x
)
=
definedIdents`
x
instance
AllIdents
Rhs
where
globalIdents`
rhs
=
[
i
\\
i
<-
globalIdents
rhs
.
rhs_alts
++
globalIdents
rhs
.
rhs_locals
|
not
(
isMember
i
(
definedIdents
rhs
.
rhs_locals
))]
definedIdents`
_
=
[]
instance
AllIdents
LocalDefs
where
globalIdents`
(
LocalParsedDefs
defs
)
=
globalIdents`
defs
globalIdents`
_
=
abort
"AllIdents LocalDefs
\n
"
definedIdents`
(
LocalParsedDefs
defs
)
=
definedIdents`
defs
definedIdents`
_
=
abort
"definedIdents` LocalDefs
\n
"
instance
AllIdents
OptGuardedAlts
where
globalIdents`
(
UnGuardedExpr
e
)
=
globalIdents`
e
globalIdents`
(
GuardedAlts
es
oth
)
=
globalIdents`
es
++
globalIdents`
oth
definedIdents`
_
=
[]
instance
AllIdents
ExprWithLocalDefs
where
globalIdents`
e
=
[
i
\\
i
<-
globalIdents
e
.
ewl_expr
|
not
(
isMember
i
(
globalIdents
e
.
ewl_locals
))]
definedIdents`
_
=
[]
// NOTE ewl_nodes?
instance
AllIdents
GuardedExpr
where
globalIdents`
e
=
globalIdents`
e
.
alt_guard
++
globalIdents`
e
.
alt_expr
definedIdents`
_
=
[]
// NOTE alt_nodes?
instance
AllIdents
CaseAlt
where
globalIdents`
a
=
[
i
\\
i
<-
globalIdents
a
.
calt_rhs
|
not
(
isMember
i
(
globalIdents
a
.
calt_pattern
))]
definedIdents`
_
=
[]
instance
AllIdents
Qualifier
where
globalIdents`
q
=
globalIdents`
q
.
qual_generators
++
globalIdents`
q
.
qual_let_defs
++
globalIdents`
q
.
qual_filter
definedIdents`
q
=
definedIdents`
q
.
qual_generators
instance
AllIdents
Generator
where
globalIdents`
g
=
globalIdents`
g
.
gen_expr
definedIdents`
g
=
definedIdents`
g
.
gen_pattern
instance
AllIdents
Sequence
where
globalIdents`
s
=
case
s
of
SQ_FromThen
_
a
b
->
globalIdents`
[
a
,
b
]
SQ_FromThenTo
_
a
b
c
->
globalIdents`
[
a
,
b
]
SQ_From
_
a
->
globalIdents`
a
SQ_FromTo
_
a
b
->
globalIdents`
[
a
,
b
]
definedIdents`
_
=
[]
instance
AllIdents
ParsedSelection
where
globalIdents`
ps
=
case
ps
of
PS_Record
id
_
->
[
id
.
id_name
]
PS_QualifiedRecord
_
s
_
->
[
s
]
PS_Array
e
->
globalIdents`
e
PS_Erroneous
->
[]
definedIdents`
_
=
[]
import
StdMisc
CleanPrettyPrint
@
25b5f828
Compare
1a9e842b
...
25b5f828
Subproject commit
1a9e842bb4c58ec4ff270b843d878f3fce8e0c22
Subproject commit
25b5f828ddb77a10482ba69b5f35f34c45779cc8
CleanTypeUnifier
@
d052c6fb
Compare
c68334f3
...
d052c6fb
Subproject commit
c68334f3df6257e0a17259974a0ec25278981d0c
Subproject commit
d052c6fb6fcbff6316f913892f310ce476e5bf0b
CloogleDBFactory.dcl
View file @
7c5e0a80
...
...
@@ -4,6 +4,8 @@ definition module CloogleDBFactory
* Functions to populate a database using the Clean compiler frontend
*/
from
Data
.
Set
import
::
Set
import
CloogleDB
::
TemporaryDB
...
...
@@ -69,15 +71,15 @@ indexModule :: !Bool !String !Module !Library
* - The module
*/
findModuleContents
::
!
Bool
!
String
!*
World
->
*(
![(
LocationInModule
,
FunctionEntry
,
[
String
]
)]
,
![(
LocationInModule
,
FunctionEntry
,
[
String
]
)]
,
![(
LocationInModule
,
FunctionEntry
,
[
String
]
)]
->
*(
![(
LocationInModule
,
FunctionEntry
,
Set
String
)]
,
![(
LocationInModule
,
FunctionEntry
,
Set
String
)]
,
![(
LocationInModule
,
FunctionEntry
,
Set
String
)]
,
![(
LocationInModule
,
TypeDefEntry
)]
,
![(
LocationInModule
,
ClassEntry
,
[(
String
,
FunctionEntry
,
[
String
]
)])]
,
![(
LocationInModule
,
ClassEntry
,
[(
String
,
FunctionEntry
,
Set
String
)])]
,
![(
Name
,
[(
Type
,
String
)],
LocationInModule
)]
,
![(
Name
,
[(
Type
,
String
,
LocationInModule
)])]
,
![(
Name
,
Type
,
String
,
LocationInModule
)]
,
!(
Name
,
ModuleEntry
,
[
String
]
)
,
!(
Name
,
ModuleEntry
,
Set
String
)
,
!*
World
)
...
...
CloogleDBFactory.icl
View file @
7c5e0a80
...
...
@@ -23,10 +23,11 @@ import Data.List
from
Data
.
Map
import
::
Map
import
qualified
Data
.
Map
as
M
import
Data
.
Maybe
import
qualified
Data
.
Set
as
S
import
Data
.
Tuple
import
System
.
Directory
import
System
.
FilePath
from
Text
import
class
Text
(
concat
,
indexOf
,
replaceSubString
),
instance
Text
String
from
Text
import
class
Text
(
concat
,
indexOf
,
replaceSubString
),
instance
Text
String
,
<+
import
CleanPrettyPrint
...
...
@@ -95,16 +96,16 @@ from Doc import :: ModuleDoc, :: FunctionDoc{..}, :: ClassDoc, :: TypeDoc{..},
class
docFields
(..),
instance
docFields
TypeDoc
,
traceParseError
,
traceParseWarnings
,
constructorToFunctionDoc
,
functionToClassMemberDoc
,
addClassMemberDoc
import
All
Idents
import
Idents
::
TemporaryDB
=
{
temp_functions
::
![[('
CDB
'.
FunctionEntry
,
[
String
]
)]]
,
temp_classes
::
![[('
CDB
'.
ClassEntry
,
[(
String
,
'
CDB
'.
FunctionEntry
,
[
String
]
)])]]
=
{
temp_functions
::
![[('
CDB
'.
FunctionEntry
,
'S'
.
Set
String
)]]
,
temp_classes
::
![[('
CDB
'.
ClassEntry
,
[(
String
,
'
CDB
'.
FunctionEntry
,
'S'
.
Set
String
)])]]
,
temp_instances
::
![[(!'
CDB
'.
Name
,
![(!'
CDB
'.
Type
,
!
String
)],
!'
CDB
'.
Location
)]]
,
temp_types
::
![['
CDB
'.
TypeDefEntry
]]
,
temp_derivations
::
![[(!'
CDB
'.
Name
,
![(!'
CDB
'.
Type
,
!
String
,
!'
CDB
'.
Location
)])]]
,
temp_class_derivations
::
![[(!'
CDB
'.
Name
,
!'
CDB
'.
Type
,
!
String
,
!'
CDB
'.
Location
)]]
,
temp_modules
::
![(
ModuleEntry
,
[
String
]
)]
,
temp_modules
::
![(
ModuleEntry
,
'S'
.
Set
String
)]
}
// TODO function usages in instances/derivations
...
...
@@ -119,9 +120,30 @@ newTemporaryDB
,
temp_modules
=
[]
}
instance
<
(
Maybe
a
)
|
<
a
where
<
(
Just
x
)
(
Just
y
)
=
x
<
y
<
(
Just
_)
Nothing
=
True
<
_
_
=
False
instance
<
Location
where
<
(
Location
l1
m1
_
d1
i1
n1
)
(
Location
l2
m2
_
d2
i2
n2
)
=
((
l1
,
m1
,
n1
),(
d1
,
i1
))
<
((
l2
,
m2
,
n2
),
(
d2
,
i2
))
<
(
Location
_
_
_
_
_
_)
_
=
True
<
_
(
Location
_
_
_
_
_
_)
=
False
<
(
Builtin
a
_)
(
Builtin
b
_)
=
a
<
b
<
(
Builtin
_
_)
_
=
True
<
_
_
=
False
finaliseDB
::
![
CloogleEntry
]
!
TemporaryDB
->
*'
CDB
'.
CloogleDB
finaliseDB
extra
tdb
=
{
db
=
newDB
entries
{
db
=
'
DB
'.
mapInPlace
link
$
newDB
entries
,
name_ngrams
=
foldr
(
uncurry
index
)
(
newNGramIndex
3
True
)
[('
CDB
'.
getName
loc
,
i
)
\\
(
i
,
e
)
<-
entridxs
,
Just
loc
<-
['
CDB
'.
getLocation
e
]]
,
name_map
=
foldr
(\(
name
,
i
)
->
flip
'M'
.
alter
name
\
is
->
case
is
of
...
...
@@ -148,10 +170,9 @@ finaliseDB extra tdb =
,
always_unique
=
always_unique
}
where
entries
=
[
link
i
e
\\
Right
e
<-
filter
(\
e
->
e
=:(
Right
_))
entries`
&
i
<-
[
0
..]]
where
link
::
Int
CloogleEntry
->
CloogleEntry
link
_
(
TypeDefEntry
tde
)
=
TypeDefEntry
link
::
!
Int
!
CloogleEntry
->
CloogleEntry
link
i
e
=
trace_n
(
"Linking #"
<+
i
<+
fromMaybe
""
((\
loc
->
": "
<+
'
CDB
'.
getName
loc
)
<$>
'
CDB
'.
getLocation
e
))
case
e
of
TypeDefEntry
tde
->
TypeDefEntry
{
tde
&
tde_instances
=
idxfilter
\
e
->
case
e
of
InstanceEntry
ie
->
or
[
t
==
name
\\
'T'
.
Type
t
_
<-
concatMap
(
'T'
.
subtypes
o
fst
)
ie
.
ie_types
]
...
...
@@ -164,7 +185,7 @@ where
_
->
False
}
with
name
=
'T'
.
td_name
$
'
CDB
'.
getTypeDef
tde
link
i
(
ClassEntry
ce
)
=
ClassEntry
ClassEntry
ce
->
ClassEntry
{
ce
&
ce_instances
=
idxfilter
\
e
->
case
e
of
InstanceEntry
ie
->
ie
.
ie_class
==
name
...
...
@@ -172,7 +193,7 @@ where
,
ce_members
=
idxfilter
\
e
->
case
e
of
FunctionEntry
fe
->
fe
.
fe_class
==
Just
(
Index
i
)
_
->
False
,
ce_usages
=
idxfilter
`
\
e
->
or
[
cls
==
name
\\
'T'
.
Instance
cls
_
<-
context
e
]
,
ce_usages
=
idxfilter
\
e
->
or
[
cls
==
name
\\
'T'
.
Instance
cls
_
<-
context
e
]
}
with
name
=
'
CDB
'.
getName
ce
.
ce_loc
...
...
@@ -184,30 +205,28 @@ where
|
name
==
'
CDB
'.
getName
ce
.
ce_loc
=
[]
|
otherwise
=
classContext
ce
context
_
=
[]
link
_
(
FunctionEntry
fe
)
=
FunctionEntry
FunctionEntry
fe
->
FunctionEntry
{
fe
&
fe_derivations
=
case
fe
.
fe_derivations
of
Nothing
->
Nothing
Just
_
->
Just
$
idxfilter
\
e
->
case
e
of
DeriveEntry
de
->
de
.
de_generic
==
'
CDB
'.
getName
fe
.
fe_loc
DeriveEntry
de
->
de
.
de_generic
==
name
_
->
False
,
fe_usages
=
idxfilter`
\
e
->
case
e
of
FunctionEntry
fe
->
case
find
(\(
fun
,_)
->
fun
.
fe_loc
==
fe
.
fe_loc
)
function_entries
of
Nothing
->
False
Just
(_,
imps
)
->
isMember
name
imps
_
->
False
,
fe_usages
=
fromMaybe
[]
(
'M'
.
get
('
CDB
'.
getName
fe
.
fe_loc
)
global_functions_map
)
}
w
here
name
=
'
CDB
'.
getName
fe
.
fe_loc
link
_
(
ModuleEntry
me
)
=
ModuleEntry
w
ith
name
=
'
CDB
'.
getName
fe
.
fe_loc
ModuleEntry
me
->
ModuleEntry
{
me
&
me_usages
=
idxfilter
`
\
e
->
case
e
of
&
me_usages
=
idxfilter
\
e
->
case
e
of
ModuleEntry
me
->
case
find
(\(
mod
,_)
->
mod
.
me_loc
==
me
.
me_loc
)
tdb
.
temp_modules
of
Nothing
->
False
Just
(_,
imps
)
->
isM
ember
name
imps
Just
(_,
imps
)
->
'S'
.
m
ember
name
imps
_
->
False
}
where
name
=
'
CDB
'.
getName
me
.
me_loc
link
_
e
=
e
with
name
=
'
CDB
'.
getName
me
.
me_loc
e
->
e
entries
=
[
e
\\
Right
e
<-
entries`
]
entries`
=
map
Right
(
extra
++
[
TypeDefEntry
tde
\\
tds
<-
tdb
.
temp_types
,
tde
<-
tds
]
++
...
...
@@ -262,6 +281,17 @@ where
instanceEq
::
(
String
,
[('
CDB
'.
Type
,
a
)],
b
)
(
String
,
[('
CDB
'.
Type
,
a
)],
b
)
->
Bool
instanceEq
(
s
,
ts
,
_)
(
s2
,
ts2
,
_)
=
s
==
s2
&&
all
(
uncurry
(
isomorphic_to
))
(
zip2
(
map
fst
ts
)
(
map
fst
ts2
))
global_functions_map
=
'M'
.
fromList
$
map
(\
gidxs
=:[(
g
,_):_]
->
(
g
,
map
snd
gidxs
))
$
groupBy
((==)
`
on`
fst
)
$
sortBy
((<)
`
on`
fst
)
$
flatten
[[(
g
,
idx
)
\\
g
<-
removeDup
(
'S'
.
toList
globs
)]
// TODO remove removeDup when Data.Set difference is fixed
\\
idx
<-
fidxs
&
(
fe
,
globs
)
<-
[(
fe
,
'S'
.
newSet
)
\\
FunctionEntry
fe
<-
extra
]
++
function_entries
]
where
fidxs
=
[
idx
\\
(
idx
,
FunctionEntry
_)
<-
entridxs
]
function_entries
=
flatten
tdb
.
temp_functions
++
[(
{
fun
&
fe_kind
=
case
fun
.
fe_kind
of
Function
->
ClassMember
;
Macro
->
ClassMacro
...
...
@@ -275,9 +305,6 @@ where
idxfilter
f
=
[
idx
\\
(
idx
,
e
)
<-
entridxs
|
f
e
]
idxhd
=
hd
o
idxfilter
// WARNING: indexes may be wrong after meta-instances due to the use of Left
idxfilter`
f
=
[
idx
\\
(
idx
,
Right
e
)
<-
zip2
[
Index
i
\\
i
<-
[
0
..]]
entries`
|
f
e
]
coreidxs
=
idxfilter
\
e
->
case
'
CDB
'.
getLocation
e
of
Nothing
->
False
Just
l
->
case
('
CDB
'.
getLibrary
l
,
'
CDB
'.
getModule
l
)
of
...
...
@@ -362,7 +389,7 @@ indexModule include_locals root mod lib modf db w
{
db
&
temp_functions
=
[
[({
f
&
fe_loc
=
castLoc
modname
loc
},
idents
)
\\
(
loc
,
f
,
idents
)
<-
functions
++
macros
++
generics
]
,
[(
f
,
[]
)
\\
td
<-
typedefs
,
f
<-
constructor_functions
td
++
record_functions
td
]
,
[(
f
,
'S'
.
newSet
)
\\
td
<-
typedefs
,
f
<-
constructor_functions
td
++
record_functions
td
]
:
db
.
temp_functions
]
,
temp_classes
=
[[({
ce
&
ce_loc
=
castLoc
modname
loc
},
fs
)
\\
(
loc
,
ce
,
fs
)
<-
clss
]:
db
.
temp_classes
]
...
...
@@ -389,15 +416,15 @@ instance zero LocationInModule
where
zero
=
{
dcl_line
=
Nothing
,
icl_line
=
Nothing
,
name
=
Nothing
}
findModuleContents
::
!
Bool
!
String
!*
World
->
*(
![(
LocationInModule
,
'
CDB
'.
FunctionEntry
,
[
String
]
)]
,
![(
LocationInModule
,
'
CDB
'.
FunctionEntry
,
[
String
]
)]
,
![(
LocationInModule
,
'
CDB
'.
FunctionEntry
,
[
String
]
)]
->
*(
![(
LocationInModule
,
'
CDB
'.
FunctionEntry
,
'S'
.
Set
String
)]
,
![(
LocationInModule
,
'
CDB
'.
FunctionEntry
,
'S'
.
Set
String
)]
,
![(
LocationInModule
,
'
CDB
'.
FunctionEntry
,
'S'
.
Set
String
)]
,
![(
LocationInModule
,
'
CDB
'.
TypeDefEntry
)]
,
![(
LocationInModule
,
'
CDB
'.
ClassEntry
,
[(
String
,
'
CDB
'.
FunctionEntry
,
[
String
]
)])]
,
![(
LocationInModule
,
'
CDB
'.
ClassEntry
,
[(
String
,
'
CDB
'.
FunctionEntry
,
'S'
.
Set
String
)])]
,
![('
CDB
'.
Name
,
[('
CDB
'.
Type
,
String
)],
LocationInModule
)]
,
![('
CDB
'.
Name
,
[('
CDB
'.
Type
,
String
,
LocationInModule
)])]
,
![('
CDB
'.
Name
,
'
CDB
'.
Type
,
String
,
LocationInModule
)]
,
!('
CDB
'.
Name
,
'
CDB
'.
ModuleEntry
,
[
String
]
)
,
!('
CDB
'.
Name
,
'
CDB
'.
ModuleEntry
,
'S'
.
Set
String
)
,
!*
World
)
findModuleContents
include_locals
path
w
...
...
@@ -407,7 +434,7 @@ findModuleContents include_locals path w
Right
dcl
->
(
dcl
.
mod_defs
,
dcl
.
mod_ident
.
id_name
)
#!
(
icl
,
icl_symbols
,
w
)
=
readModule
True
w
#!
icl
=
case
icl
of
Left
_
->
[];
Right
icl
->
icl
.
mod_defs
#!
imports
=
[
i
.
import_module
.
id_name
\\
PD_Import
is
<-
icl
,
i
<-
is
]
#!
imports
=
'S'
.
fromList
[
i
.
import_module
.
id_name
\\
PD_Import
is
<-
icl
,
i
<-
is
]
#!
contents
=:(
functions
,
rules
,
generics
,
typedefs
,
clss
,
insts
,
derivs
,
clsderivs
)
=
(
combine
cmpLocFst3
joinLocFstIds
pd_typespecs
dcl
dcl_symbols
icl
icl_symbols
,
combine
cmpLocFst3
joinLocFstIds
pd_rewriterules
dcl
dcl_symbols
icl
icl_symbols
...
...
@@ -464,8 +491,8 @@ where
joinLocFst3
::
(
LocationInModule
,
a
,
b
)
(
LocationInModule
,
c
,
d
)
->
(
LocationInModule
,
a
,
b
)
joinLocFst3
(
l1
,
a
,
b
)
(
l2
,_,_)
=
(
joinLoc
l1
l2
,
a
,
b
)
joinLocFstIds
::
(
LocationInModule
,
a
,
[
String
])
(
LocationInModule
,
b
,
[
String
])
->
(
LocationInModule
,
a
,
[
String
]
)
joinLocFstIds
(
l1
,
a
,
idsa
)
(
l2
,_,
idsb
)
=
(
joinLoc
l1
l2
,
a
,
removeDup
(
idsa
++
idsb
)
)
joinLocFstIds
::
(
LocationInModule
,
a
,
'S'
.
Set
String
)
(
LocationInModule
,
b
,
'S'
.
Set
String
)
->
(
LocationInModule
,
a
,
'S'
.
Set
String
)
joinLocFstIds
(
l1
,
a
,
idsa
)
(
l2
,_,
idsb
)
=
(
joinLoc
l1
l2
,
a
,
'S'
.
union
idsa
idsb
)
joinTypeDefs
::
(
LocationInModule
,
'
CDB
'.
TypeDefEntry
)
(
LocationInModule
,
'
CDB
'.
TypeDefEntry
)
->
(
LocationInModule
,
'
CDB
'.
TypeDefEntry
)
joinTypeDefs
(
a
,
t
)
(
b
,
u
)
=
(
joinLoc
a
b
,
'
CDB
'.
mergeTypeDefEntries
t
u
)
...
...
@@ -500,7 +527,7 @@ where
}
pd_module
_
=
zero
pd_rewriterules
::
!
Bool
![
ParsedDefinition
]
SymbolTable
->
[(
LocationInModule
,
'
CDB
'.
FunctionEntry
,
[
String
]
)]
pd_rewriterules
::
!
Bool
![
ParsedDefinition
]
SymbolTable
->
[(
LocationInModule
,
'
CDB
'.
FunctionEntry
,
'S'
.
Set
String
)]
pd_rewriterules
dcl
defs
st
=
[(
setLine
dcl
pos
{
zero
&
name
=
Just
id
.
id_name
}
,
let
doc
=
findDoc
hideIsUsedReturn
id
st
in
...
...
@@ -512,7 +539,7 @@ where
,
fe_priority
=
findPrio
id
>>=
'T'
.
toMaybePriority
,
fe_documentation
=
doc
}
,
globalIdents
pd
,
(
idents
ICExpression
pd
).
globals
)
\\
pd
=:(
PD_Function
pos
id
isinfix
args
rhs
_)
<-
defs
]
where
priostring
::
Ident
ParsedDefinition
->
String
...
...
@@ -543,7 +570,7 @@ where
\\
gcdefs
<-
[
ds
\\
PD_Derive
ds
<-
defs
]
++
[[
d
]
\\
PD_GenericCase
d
_
<-
defs
]
,
{
gc_type
,
gc_pos
,
gc_gcf
=
GCF
id
_}
<-
gcdefs
]
pd_generics
::
!
Bool
![
ParsedDefinition
]
SymbolTable
->
[(
LocationInModule
,
'
CDB
'.
FunctionEntry
,
[
String
]
)]
pd_generics
::
!
Bool
![
ParsedDefinition
]
SymbolTable
->
[(
LocationInModule
,
'
CDB
'.
FunctionEntry
,
'S'
.
Set
String
)]
pd_generics
dcl
defs
st
=
[(
setLine
dcl
gen_pos
{
zero
&
name
=
Just
id_name
}
,
{
zero
...
...
@@ -553,10 +580,10 @@ where
,
fe_documentation
=
findDoc
hideIsUsedReturn
id
st
,
fe_derivations
=
Just
[]
}
,
[]
,
'S'
.
newSet
)
\\
gen
=:(
PD_Generic
{
gen_ident
=
id
=:{
id_name
},
gen_pos
,
gen_type
,
gen_vars
})
<-
defs
]
pd_typespecs
::
!
Bool
![
ParsedDefinition
]
SymbolTable
->
[(
LocationInModule
,
'
CDB
'.
FunctionEntry
,
[
String
]
)]
pd_typespecs
::
!
Bool
![
ParsedDefinition
]
SymbolTable
->
[(
LocationInModule
,
'
CDB
'.
FunctionEntry
,
'S'
.
Set
String
)]
pd_typespecs
dcl
defs
st
=
[(
setLine
dcl
pos
{
zero
&
name
=
Just
id_name
}
,
{
zero
...
...
@@ -565,7 +592,7 @@ where
,
fe_representation
=
Just
$
cpp
ts
,
fe_documentation
=
findDoc
hideIsUsedReturn
id
st
}
,
globalIdents
[
pd
\\
pd
=:(
PD_Function
_
id
_
_
_
_)
<-
defs
|
id
.
id_name
==
id_name
]
// TODO check
,
(
idents
ICExpression
[
pd
\\
pd
=:(
PD_Function
_
id
_
_
_
_)
<-
defs
|
id
.
id_name
==
id_name
]).
globals
)
\\
ts
=:(
PD_TypeSpec
pos
id
=:{
id_name
}
p
(
Yes
t
)
funspecs
)
<-
defs
]
pd_class_derivations
::
!
Bool
![
ParsedDefinition
]
SymbolTable
->
[('
CDB
'.
Name
,
'
CDB
'.
Type
,
String
,
LocationInModule
)]
...
...
@@ -581,7 +608,7 @@ where
[(
i
.
pi_ident
.
id_name
,
i
.
pi_types
,
i
.
pi_pos
)
\\
PD_Instance
{
pim_pi
=
i
}
<-
defs
]
++
[(
i
.
pi_ident
.
id_name
,
i
.
pi_types
,
i
.
pi_pos
)
\\
PD_Instances
pis
<-
defs
,
{
pim_pi
=
i
}
<-
pis
]
pd_classes
::
!
Bool
![
ParsedDefinition
]
SymbolTable
->
[(
LocationInModule
,
'
CDB
'.
ClassEntry
,
[(
String
,
'
CDB
'.
FunctionEntry
,
[
String
]
)])]
pd_classes
::
!
Bool
![
ParsedDefinition
]
SymbolTable
->
[(
LocationInModule
,
'
CDB
'.
ClassEntry
,
[(
String
,
'
CDB
'.
FunctionEntry
,
'S'
.
Set
String
)])]
pd_classes
dcl
defs
st
=
[
let
typespecs
=
pd_typespecs
True
clsdefs
st
...
...
DB.dcl
View file @
7c5e0a80
...
...
@@ -73,7 +73,7 @@ getEntries :: *(DB v ak a) -> *([(v, Map ak a)], *DB v ak a)
/**
* An in-place map over all entries (also the excluded ones).
*/
mapInPlace
::
(
v
->
v
)
*(
DB
v
ak
a
)
->
*(
DB
v
ak
a
)
mapInPlace
::
(
Int
v
->
v
)
*(
DB
v
ak
a
)
->
*(
DB
v
ak
a
)
/**
* Linear search for entries. The search function returns whether the entry
...
...
DB.icl
View file @
7c5e0a80
...
...
@@ -7,7 +7,7 @@ import StdInt
import
StdString
import
StdTuple
from
Data
.
Func
import
$
from
Data
.
Func
import
$
,
hyperstrict
import
Data
.
Functor
import
Data
.
Map
import
Data
.
Maybe
...
...
@@ -23,7 +23,7 @@ instance == Index where == (Index a) (Index b) = a == b
instance
<
Index
where
<
(
Index
a
)
(
Index
b
)
=
a
<
b
newDB
::
[
v
]
->
*
DB
v
ak
a
newDB
vs
=
DB
{{
value
=
v
,
included
=
True
,
annotations
=
newMap
}
\\
v
<-
vs
}
newDB
vs
=
DB
{{
value
=
hyperstrict
v
,
included
=
True
,
annotations
=
newMap
}
\\
v
<-
vs
}
saveDB
::
*(
DB
v
ak
a
)
*
File
->
*(*
DB
v
ak
a
,
*
File
)
|
JSONEncode
{|*|}
v
saveDB
(
DB
db
)
f
...
...
@@ -98,15 +98,17 @@ where
#
(
r
,
es
)
=
collect
(
i
-1
)
es
=
(
if
e
.
included
[(
e
.
value
,
e
.
annotations
):
r
]
r
,
es
)
mapInPlace
::
(
v
->
v
)
*(
DB
v
ak
a
)
->
*(
DB
v
ak
a
)
mapInPlace
::
(
Int
v
->
v
)
*(
DB
v
ak
a
)
->
*(
DB
v
ak
a
)
mapInPlace
f
(
DB
db
)
#
(
s
,
db
)
=
usize
db
=
DB
(
upd
(
s
-1
)
db
)
=
DB
(
upd
0
s
db
)
where
upd
-1
es
=
es
upd
i
es
#
(
e
,
es
)
=
es
![
i
]
=
upd
(
i
-1
)
{
es
&
[
i
]={
e
&
value
=
f
e
.
value
}}
//upd :: !Int !Int !*{!Entry v ak a} -> *{!Entry v ak a}
upd
i
s
es
|
i
==
s
=
es
#!
(
e
,
es
)
=
es
![
i
]
#!
e
&
value
=
hyperstrict
$
f
i
e
.
value
=
upd
(
i
+1
)
s
{
es
&
[
i
]=
e
}
search
::
!
SearchMode
(
v
->
(
Bool
,
[(
ak
,
a
)]))
*(
DB
v
ak
a
)
->
*
DB
v
ak
a
|
==,
<
ak
search
mode
f
(
DB
db
)
...
...
Idents.dcl
0 → 100644
View file @
7c5e0a80
definition
module
Idents
from
StdClass
import
class
Eq
from
StdList
import
isMember
,
removeDup
from
StdOverloaded
import
class
==