Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Open sidebar
Cloogle
Cloogle
Commits
7bd21048
Verified
Commit
7bd21048
authored
Jan 17, 2018
by
Camil Staps
🚀
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
WIP for function usages (clean-cloogle/cloogle.org#52)
parent
ed7e5eed
Changes
6
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
288 additions
and
52 deletions
+288
-52
AllIdents.dcl
AllIdents.dcl
+26
-0
AllIdents.icl
AllIdents.icl
+190
-0
CloogleDB.dcl
CloogleDB.dcl
+1
-0
CloogleDB.icl
CloogleDB.icl
+6
-2
CloogleDBFactory.dcl
CloogleDBFactory.dcl
+4
-4
CloogleDBFactory.icl
CloogleDBFactory.icl
+61
-46
No files found.
AllIdents.dcl
0 → 100644
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
0 → 100644
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
CloogleDB.dcl
View file @
7bd21048
...
...
@@ -102,6 +102,7 @@ derive JSONDecode CloogleEntry
,
fe_documentation
::
!
Maybe
FunctionDoc
//* Documentation on this entry
,
fe_class
::
!
Maybe
Index
//* The class, for class members
,
fe_derivations
::
!
Maybe
[
Index
]
//* The DerivaionEntries
,
fe_usages
::
![
Index
]
//* FunctionEntries where the implementation uses this function
}
/**
...
...
CloogleDB.icl
View file @
7bd21048
...
...
@@ -98,6 +98,7 @@ where
,
fe_documentation
=
Nothing
,
fe_class
=
Nothing
,
fe_derivations
=
Nothing
,
fe_usages
=
[]
}
instance
zero
ModuleEntry
...
...
@@ -456,9 +457,11 @@ filterUsages names wrap=:{db,name_map}
#
db
=
'
DB
'.
searchIndices
Intersect
(
sort
[(
i
,[(
ExactResult
,
1
)])
\\
is
<-
idxss
,
i
<-
is
])
db
// For all lists of entries, the corresponding usages
#
(
entriess
,
db
)
=
mapSt
'
DB
'.
getIndices
idxss
db
#
usagess
=
map
(
foldr
1
mergeUnion
o
map
\
e
->
getUsages
e
.
value
)
entriess
#
usagess
=
map
(
foldr
mergeUnion
[]
o
map
\
e
->
getUsages
e
.
value
)
entriess
// AND all usages together
#
usages
=
foldr1
mergeIntersect
usagess
#
usages
=
case
usagess
of
[]
->
[]
us
->
foldr1
mergeIntersect
us
#
db
=
'
DB
'.
searchIndices
AddExcluded
[(
u
,[])
\\
u
<-
usages
]
db
=
{
wrap
&
db
=
db
}
where
...
...
@@ -466,6 +469,7 @@ where
getUsages
(
TypeDefEntry
tde
)
=
tde
.
tde_usages
getUsages
(
ClassEntry
ce
)
=
ce
.
ce_usages
getUsages
(
ModuleEntry
me
)
=
me
.
me_usages
getUsages
(
FunctionEntry
fe
)
=
fe
.
fe_usages
getUsages
_
=
[]
// Efficient union on sorted lists
...
...
CloogleDBFactory.dcl
View file @
7bd21048
...
...
@@ -69,11 +69,11 @@ indexModule :: !Bool !String !Module !Library
* - The module
*/
findModuleContents
::
!
Bool
!
String
!*
World
->
*(
![(
LocationInModule
,
FunctionEntry
)]
,
![(
LocationInModule
,
FunctionEntry
)]
,
![(
LocationInModule
,
FunctionEntry
)]
->
*(
![(
LocationInModule
,
FunctionEntry
,
[
String
]
)]
,
![(
LocationInModule
,
FunctionEntry
,
[
String
]
)]
,
![(
LocationInModule
,
FunctionEntry
,
[
String
]
)]
,
![(
LocationInModule
,
TypeDefEntry
)]
,
![(
LocationInModule
,
ClassEntry
,
[(
String
,
FunctionEntry
)])]
,
![(
LocationInModule
,
ClassEntry
,
[(
String
,
FunctionEntry
,
[
String
]
)])]
,
![(
Name
,
[(
Type
,
String
)],
LocationInModule
)]
,
![(
Name
,
[(
Type
,
String
,
LocationInModule
)])]
,
![(
Name
,
Type
,
String
,
LocationInModule
)]
...
...
CloogleDBFactory.icl
View file @
7bd21048
...
...
@@ -95,16 +95,18 @@ from Doc import :: ModuleDoc, :: FunctionDoc{..}, :: ClassDoc, :: TypeDoc{..},
class
docFields
(..),
instance
docFields
TypeDoc
,
traceParseError
,
traceParseWarnings
,
constructorToFunctionDoc
,
functionToClassMemberDoc
,
addClassMemberDoc
import
AllIdents
::
TemporaryDB
=
{
temp_functions
::
![['
CDB
'.
FunctionEntry
]]
,
temp_classes
::
![[('
CDB
'.
ClassEntry
,
[(
String
,
'
CDB
'.
FunctionEntry
)])]]
=
{
temp_functions
::
![[
(
'
CDB
'.
FunctionEntry
,
[
String
])
]]
,
temp_classes
::
![[('
CDB
'.
ClassEntry
,
[(
String
,
'
CDB
'.
FunctionEntry
,
[
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
])]
}
// TODO function usages in instances/derivations
newTemporaryDB
::
TemporaryDB
newTemporaryDB
...
...
@@ -182,12 +184,20 @@ where
|
name
==
'
CDB
'.
getName
ce
.
ce_loc
=
[]
|
otherwise
=
classContext
ce
context
_
=
[]
link
_
(
FunctionEntry
fe
=:{
fe_derivations
=
Just
_}
)
=
FunctionEntry
link
_
(
FunctionEntry
fe
)
=
FunctionEntry
{
fe
&
fe_derivations
=
Just
$
idxfilter
\
e
->
case
e
of
DeriveEntry
de
->
de
.
de_generic
==
'
CDB
'.
getName
fe
.
fe_loc
_
->
False
&
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
_
->
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
}
where
name
=
'
CDB
'.
getName
fe
.
fe_loc
link
_
(
ModuleEntry
me
)
=
ModuleEntry
{
me
&
me_usages
=
idxfilter`
\
e
->
case
e
of
...
...
@@ -196,24 +206,14 @@ where
Just
(_,
imps
)
->
isMember
name
imps
_
->
False
}
where
name
=
'
CDB
'.
getName
me
.
me_loc
where
name
=
'
CDB
'.
getName
me
.
me_loc
link
_
e
=
e
entries`
=
map
Right
(
extra
++
[
FunctionEntry
fun
\\
funs
<-
tdb
.
temp_functions
,
fun
<-
funs
]
++
[
TypeDefEntry
tde
\\
tds
<-
tdb
.
temp_types
,
tde
<-
tds
]
++
[
ModuleEntry
mod
\\
(
mod
,_)
<-
tdb
.
temp_modules
]
++
map
ClassEntry
classes
++
[
FunctionEntry
{
fun
&
fe_kind
=
case
fun
.
fe_kind
of
Function
->
ClassMember
;
Macro
->
ClassMacro
,
fe_loc
='
CDB
'.
setName
fname
cls
.
ce_loc
,
fe_class
=
Just
$
idxhd
\
ce
->
case
ce
of
ClassEntry
ce
->
ce
.
ce_loc
==
cls
.
ce_loc
_
->
False
}
\\
clss
<-
tdb
.
temp_classes
,
(
cls
,
funs
)
<-
clss
,
(
fname
,
fun
)
<-
funs
]
++
map
(
FunctionEntry
o
fst
)
function_entries
++
// Normal instances
[
InstanceEntry
{
ie_class
=
cls
,
ie_types
=
types
,
ie_locations
=
map
thd3
is
}
\\
is
=:[(
cls
,
types
,_):_]
<-
groupBy
instanceEq
...
...
@@ -262,6 +262,15 @@ 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
))
function_entries
=
flatten
tdb
.
temp_functions
++
[(
{
fun
&
fe_kind
=
case
fun
.
fe_kind
of
Function
->
ClassMember
;
Macro
->
ClassMacro
,
fe_loc
='
CDB
'.
setName
fname
cls
.
ce_loc
,
fe_class
=
Just
$
idxhd
\
ce
->
case
ce
of
ClassEntry
ce
->
ce
.
ce_loc
==
cls
.
ce_loc
_
->
False
},
ids
)
\\
clss
<-
tdb
.
temp_classes
,
(
cls
,
funs
)
<-
clss
,
(
fname
,
fun
,
ids
)
<-
funs
]
entridxs
=
zip2
[
Index
i
\\
i
<-
[
0
..]]
entries
idxfilter
f
=
[
idx
\\
(
idx
,
e
)
<-
entridxs
|
f
e
]
idxhd
=
hd
o
idxfilter
...
...
@@ -352,8 +361,8 @@ indexModule include_locals root mod lib modf db w
#!
db
=
{
db
&
temp_functions
=
[
[{
f
&
fe_loc
=
castLoc
modname
loc
}
\\
(
loc
,
f
)
<-
functions
++
macros
++
generics
]
,
[
f
\\
td
<-
typedefs
,
f
<-
constructor_functions
td
++
record_functions
td
]
[
[
(
{
f
&
fe_loc
=
castLoc
modname
loc
}
,
idents
)
\\
(
loc
,
f
,
idents
)
<-
functions
++
macros
++
generics
]
,
[
(
f
,
[])
\\
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
]
...
...
@@ -380,11 +389,11 @@ instance zero LocationInModule
where
zero
=
{
dcl_line
=
Nothing
,
icl_line
=
Nothing
,
name
=
Nothing
}
findModuleContents
::
!
Bool
!
String
!*
World
->
*(
![(
LocationInModule
,
'
CDB
'.
FunctionEntry
)]
,
![(
LocationInModule
,
'
CDB
'.
FunctionEntry
)]
,
![(
LocationInModule
,
'
CDB
'.
FunctionEntry
)]
->
*(
![(
LocationInModule
,
'
CDB
'.
FunctionEntry
,
[
String
]
)]
,
![(
LocationInModule
,
'
CDB
'.
FunctionEntry
,
[
String
]
)]
,
![(
LocationInModule
,
'
CDB
'.
FunctionEntry
,
[
String
]
)]
,
![(
LocationInModule
,
'
CDB
'.
TypeDefEntry
)]
,
![(
LocationInModule
,
'
CDB
'.
ClassEntry
,
[(
String
,
'
CDB
'.
FunctionEntry
)])]
,
![(
LocationInModule
,
'
CDB
'.
ClassEntry
,
[(
String
,
'
CDB
'.
FunctionEntry
,
[
String
]
)])]
,
![('
CDB
'.
Name
,
[('
CDB
'.
Type
,
String
)],
LocationInModule
)]
,
![('
CDB
'.
Name
,
[('
CDB
'.
Type
,
String
,
LocationInModule
)])]
,
![('
CDB
'.
Name
,
'
CDB
'.
Type
,
String
,
LocationInModule
)]
...
...
@@ -400,28 +409,28 @@ findModuleContents include_locals path w
#!
icl
=
case
icl
of
Left
_
->
[];
Right
icl
->
icl
.
mod_defs
#!
imports
=
[
i
.
import_module
.
id_name
\\
PD_Import
is
<-
icl
,
i
<-
is
]
#!
contents
=:(
functions
,
rules
,
generics
,
typedefs
,
clss
,
insts
,
derivs
,
clsderivs
)
=
(
combine
cmpLocFst
joinLocFst
pd_typespecs
dcl
dcl_symbols
icl
icl_symbols
,
combine
cmpLocFst
joinLocFst
pd_rewriterules
dcl
dcl_symbols
icl
icl_symbols
,
combine
cmpLocFst
joinLocFst
pd_generics
dcl
dcl_symbols
icl
icl_symbols
,
combine
cmpLocFst
joinTypeDefs
pd_types
dcl
dcl_symbols
icl
icl_symbols
,
combine
cmpLocFst3
joinLocFst3
pd_classes
dcl
dcl_symbols
icl
icl_symbols
,
combine
cmpInsts
joinInsts
pd_instances
dcl
dcl_symbols
icl
icl_symbols
(
combine
cmpLocFst
3
joinLocFst
Ids
pd_typespecs
dcl
dcl_symbols
icl
icl_symbols
,
combine
cmpLocFst
3
joinLocFst
Ids
pd_rewriterules
dcl
dcl_symbols
icl
icl_symbols
,
combine
cmpLocFst
3
joinLocFst
Ids
pd_generics
dcl
dcl_symbols
icl
icl_symbols
,
combine
cmpLocFst
joinTypeDefs
pd_types
dcl
dcl_symbols
icl
icl_symbols
,
combine
cmpLocFst3
joinLocFst3
pd_classes
dcl
dcl_symbols
icl
icl_symbols
,
combine
cmpInsts
joinInsts
pd_instances
dcl
dcl_symbols
icl
icl_symbols
,
combineDerivs
(
pd_derivations
True
dcl
)
(
pd_derivations
False
icl
)
,
combine
cmpClsDeriv
joinClsDeriv
pd_class_derivations
dcl
dcl_symbols
icl
icl_symbols
)
#!
(
functions
,
rules
,
generics
,
typedefs
,
clss
,
insts
,
derivs
,
clsderivs
)
=
if
include_locals
contents
(
filter
(
hasDcl
o
fst
)
functions
,
filter
(
hasDcl
o
fst
)
rules
,
filter
(
hasDcl
o
fst
)
generics
(
filter
(
hasDcl
o
fst
3
)
functions
,
filter
(
hasDcl
o
fst
3
)
rules
,
filter
(
hasDcl
o
fst
3
)
generics
,
filter
(
hasDcl
o
fst
)
typedefs
,
filter
(
hasDcl
o
fst3
)
clss
,
filter
(
hasDcl
o
thd3
)
insts
,
filter
(
not
o
isEmpty
o
snd
)
(
map
(
appSnd
(
filter
(
hasDcl
o
thd3
)))
derivs
)
,
filter
(
hasDcl
o
(\(_,_,_,
x
)->
x
))
clsderivs
)
with
hasDcl
loc
=
isJust
loc
.
dcl_line
#!
rules
=
filter
(\(
r
,_)
->
not
$
any
(\(
l
,_)->
fromJust
l
.
name
==
fromJust
r
.
name
)
functions
)
rules
#!
rules
=
filter
(\(
r
,_
,_
)
->
not
$
any
(\(
l
,_
,_
)->
fromJust
l
.
name
==
fromJust
r
.
name
)
functions
)
rules
=
(
functions
,
rules
,
generics
,
typedefs
,
clss
,
insts
,
derivs
,
clsderivs
,(
modname
,
pd_module
dcl
,
imports
),
w
)
where
combine
::
(
a
a
->
Bool
)
(
a
a
->
a
)
...
...
@@ -455,6 +464,9 @@ 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
))
joinTypeDefs
::
(
LocationInModule
,
'
CDB
'.
TypeDefEntry
)
(
LocationInModule
,
'
CDB
'.
TypeDefEntry
)
->
(
LocationInModule
,
'
CDB
'.
TypeDefEntry
)
joinTypeDefs
(
a
,
t
)
(
b
,
u
)
=
(
joinLoc
a
b
,
'
CDB
'.
mergeTypeDefEntries
t
u
)
...
...
@@ -488,7 +500,7 @@ where
}
pd_module
_
=
zero
pd_rewriterules
::
!
Bool
![
ParsedDefinition
]
SymbolTable
->
[(
LocationInModule
,
'
CDB
'.
FunctionEntry
)]
pd_rewriterules
::
!
Bool
![
ParsedDefinition
]
SymbolTable
->
[(
LocationInModule
,
'
CDB
'.
FunctionEntry
,
[
String
]
)]
pd_rewriterules
dcl
defs
st
=
[(
setLine
dcl
pos
{
zero
&
name
=
Just
id
.
id_name
}
,
let
doc
=
findDoc
hideIsUsedReturn
id
st
in
...
...
@@ -500,6 +512,7 @@ where
,
fe_priority
=
findPrio
id
>>=
'T'
.
toMaybePriority
,
fe_documentation
=
doc
}
,
globalIdents
pd
)
\\
pd
=:(
PD_Function
pos
id
isinfix
args
rhs
_)
<-
defs
]
where
priostring
::
Ident
ParsedDefinition
->
String
...
...
@@ -530,7 +543,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
)]
pd_generics
::
!
Bool
![
ParsedDefinition
]
SymbolTable
->
[(
LocationInModule
,
'
CDB
'.
FunctionEntry
,
[
String
]
)]
pd_generics
dcl
defs
st
=
[(
setLine
dcl
gen_pos
{
zero
&
name
=
Just
id_name
}
,
{
zero
...
...
@@ -540,9 +553,10 @@ where
,
fe_documentation
=
findDoc
hideIsUsedReturn
id
st
,
fe_derivations
=
Just
[]
}
,
[]
)
\\
gen
=:(
PD_Generic
{
gen_ident
=
id
=:{
id_name
},
gen_pos
,
gen_type
,
gen_vars
})
<-
defs
]
pd_typespecs
::
!
Bool
![
ParsedDefinition
]
SymbolTable
->
[(
LocationInModule
,
'
CDB
'.
FunctionEntry
)]
pd_typespecs
::
!
Bool
![
ParsedDefinition
]
SymbolTable
->
[(
LocationInModule
,
'
CDB
'.
FunctionEntry
,
[
String
]
)]
pd_typespecs
dcl
defs
st
=
[(
setLine
dcl
pos
{
zero
&
name
=
Just
id_name
}
,
{
zero
...
...
@@ -551,6 +565,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
)
\\
ts
=:(
PD_TypeSpec
pos
id
=:{
id_name
}
p
(
Yes
t
)
funspecs
)
<-
defs
]
pd_class_derivations
::
!
Bool
![
ParsedDefinition
]
SymbolTable
->
[('
CDB
'.
Name
,
'
CDB
'.
Type
,
String
,
LocationInModule
)]
...
...
@@ -566,25 +581,25 @@ 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
)])]
pd_classes
::
!
Bool
![
ParsedDefinition
]
SymbolTable
->
[(
LocationInModule
,
'
CDB
'.
ClassEntry
,
[(
String
,
'
CDB
'.
FunctionEntry
,
[
String
]
)])]
pd_classes
dcl
defs
st
=
[
let
typespecs
=
pd_typespecs
True
clsdefs
st
macros
=
[(
n
,
r
)
\\
({
name
=
Just
n
},{
fe_representation
=
Just
r
})
<-
pd_rewriterules
dcl
clsdefs
st
]
macros
=
[(
n
,
(
r
,
ids
)
)
\\
({
name
=
Just
n
},{
fe_representation
=
Just
r
}
,
ids
)
<-
pd_rewriterules
dcl
clsdefs
st
]
updateRepresentation
n
fe
=
{
fe
&
fe_kind
=
if
(
isNothing
$
lookup
n
macros
)
fe
.
fe_kind
Macro
,
fe_representation
=
lookup
n
macros
<|>
fe
.
fe_representation
,
fe_representation
=
(
fst
<$>
lookup
n
macros
)
<|>
fe
.
fe_representation
,
fe_documentation
=
if
(
isSingleFunction
typespecs
id
)
((\
d
->
{
FunctionDoc
|
d
&
vars
=[]})
<$>
findDoc
hideIsUsedReturn
id
st
)
fe
.
fe_documentation
}
members
=
[(
f
,
updateRepresentation
f
et
)
\\
({
name
=
Just
f
},
et
)
<-
typespecs
]
members
=
[(
f
,
updateRepresentation
f
et
,
ids
)
\\
({
name
=
Just
f
},
et
,
ids
)
<-
typespecs
]
in
(
setLine
dcl
class_pos
{
zero
&
name
=
Just
id_name
}
,
'
CDB
'.
toClass
NoLocation
(
map
'T'
.
toTypeVar
class_args
)
(
all
(\(_,
fe
)
->
fe
.
fe_kind
==
Macro
)
members
)
(
all
(\(_,
fe
,_
)
->
fe
.
fe_kind
==
Macro
)
members
)
(
flatten
$
map
'T'
.
toTypeContext
class_context
)
(
parseClassDoc
typespecs
id
st
)
,
members
...
...
@@ -596,18 +611,18 @@ where
// the class documentation as the function's documentation. This is the
// case for classes like `class zero a :: a`, which do not have a where
// clause and hence no other place for the function's documentation.
parseClassDoc
::
[(
LocationInModule
,
'
CDB
'.
FunctionEntry
)]
Ident
SymbolTable
->
Maybe
ClassDoc
parseClassDoc
::
[(
LocationInModule
,
'
CDB
'.
FunctionEntry
,
a
)]
Ident
SymbolTable
->
Maybe
ClassDoc
parseClassDoc
members
id
st
|
isSingleFunction
members
id
=
flip
addClassMemberDoc
(
functionToClassMemberDoc
<$>
findDoc
hideIsUsedReturn
id
st
)
<$>
findDoc
hideFunctionOnClass
id
st
|
otherwise
=
flip
(
foldl
addClassMemberDoc
)
[
functionToClassMemberDoc
<$>
fe
.
fe_documentation
\\
(_,
fe
)
<-
members
]
[
functionToClassMemberDoc
<$>
fe
.
fe_documentation
\\
(_,
fe
,_
)
<-
members
]
<$>
findDoc
hideIsUsedReturn
id
st
isSingleFunction
::
[(
LocationInModule
,
'
CDB
'.
FunctionEntry
)]
Ident
->
Bool
isSingleFunction
::
[(
LocationInModule
,
'
CDB
'.
FunctionEntry
,
a
)]
Ident
->
Bool
isSingleFunction
members
id
=
length
members
==
1
&&
fromJust
(
fst
$
hd
members
).
name
==
id
.
id_name
&&
fromJust
(
fst
3
$
hd
members
).
name
==
id
.
id_name
// Hide warnings about @result and @param on single function classes
hideFunctionOnClass
(
IllegalField
"param"
)
=
False
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment