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
fc3c6b8c
Verified
Commit
fc3c6b8c
authored
Feb 09, 2018
by
Camil Staps
🚀
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Improved speed of CloogleDBFactory
parent
0e7f534c
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
44 additions
and
42 deletions
+44
-42
CloogleDBFactory.icl
CloogleDBFactory.icl
+44
-42
No files found.
CloogleDBFactory.icl
View file @
fc3c6b8c
...
...
@@ -6,7 +6,6 @@ import StdDebug
import
StdFile
from
StdFunc
import
const
,
flip
,
id
,
o
import
StdList
import
StdMisc
import
StdOrdList
import
StdOverloadedList
import
StdString
...
...
@@ -171,7 +170,7 @@ finaliseDB extra tdb =
}
where
link
::
!
Int
!
CloogleEntry
->
CloogleEntry
link
i
e
=
trace_n
(
"Linking #"
<+
i
<+
fromMaybe
""
((\
loc
->
": "
<+
'
CDB
'.
getName
loc
)
<$>
'
CDB
'.
getLocation
e
))
case
e
of
link
i
e
=
case
e
of
TypeDefEntry
tde
->
TypeDefEntry
{
tde
&
tde_instances
=
idxfilter
\
e
->
case
e
of
...
...
@@ -184,9 +183,7 @@ where
DeriveEntry
{
de_type
=
'T'
.
Arrow
_}
->
name
==
"(->)"
DeriveEntry
{
de_type
=
'T'
.
Func
_
_
_}
->
name
==
"(->)"
_
->
False
,
tde_usages
=
idxfilter
\
e
->
case
e
of
FunctionEntry
{
fe_type
=
Just
t
}
->
or
[
t
==
name
\\
'T'
.
Type
t
_
<-
'T'
.
subtypes
t
]
_
->
False
,
tde_usages
=
fromMaybe
[]
(
'M'
.
get
name
type_usages_map
)
}
with
name
=
'T'
.
td_name
$
'
CDB
'.
getTypeDef
tde
ClassEntry
ce
->
ClassEntry
...
...
@@ -197,18 +194,9 @@ 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
=
fromMaybe
[]
(
'M'
.
get
name
class_usages_map
)
}
with
name
=
'
CDB
'.
getName
ce
.
ce_loc
context
::
'
CDB
'.
CloogleEntry
->
[
'T'
.
TypeRestriction
]
context
(
FunctionEntry
{
fe_type
=
Just
t
})
=
'T'
.
allRestrictions
t
context
(
TypeDefEntry
tde
)
=
'T'
.
typeRhsRestrictions
$
'T'
.
td_rhs
$
'
CDB
'.
getTypeDef
tde
context
(
ClassEntry
ce
)
|
name
==
'
CDB
'.
getName
ce
.
ce_loc
=
[]
|
otherwise
=
classContext
ce
context
_
=
[]
with
name
=
'
CDB
'.
getName
ce
.
ce_loc
FunctionEntry
fe
->
FunctionEntry
{
fe
&
fe_derivations
=
case
fe
.
fe_derivations
of
...
...
@@ -216,20 +204,54 @@ where
Just
_
->
Just
$
idxfilter
\
e
->
case
e
of
DeriveEntry
de
->
de
.
de_generic
==
name
_
->
False
,
fe_usages
=
fromMaybe
[]
(
'M'
.
get
('
CDB
'.
getName
fe
.
fe_loc
)
global_
functions_map
)
,
fe_usages
=
fromMaybe
[]
(
'M'
.
get
name
function
_usage
s_map
)
}
with
name
=
'
CDB
'.
getName
fe
.
fe_loc
ModuleEntry
me
->
ModuleEntry
{
me
&
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
)
->
'S'
.
member
name
imps
_
->
False
&
me_usages
=
fromMaybe
[]
(
'M'
.
get
name
module_usages_map
)
}
with
name
=
'
CDB
'.
getName
me
.
me_loc
e
->
e
make_usage_map
::
([[(
a
,
b
)]]
->
'M'
.
Map
a
[
b
])
|
<,
==
a
make_usage_map
=
'M'
.
fromList
o
map
(\
gidxs
=:[(
g
,_):_]
->
(
g
,
map
snd
gidxs
))
o
groupBy
((==)
`
on`
fst
)
o
sortBy
((<)
`
on`
fst
)
o
flatten
type_usages_map
=
make_usage_map
[[(
t
,
idx
)
\\
'T'
.
Type
t
_
<-
'T'
.
subtypes
t
]
\\
(
idx
,
FunctionEntry
{
fe_type
=
Just
t
})
<-
entridxs
]
class_usages_map
=
make_usage_map
[[(
cls
,
idx
)
\\
'T'
.
Instance
cls
_
<-
context
e
]
\\
(
idx
,
e
)
<-
entridxs
]
where
context
::
'
CDB
'.
CloogleEntry
->
[
'T'
.
TypeRestriction
]
context
(
FunctionEntry
{
fe_type
=
Just
t
})
=
'T'
.
allRestrictions
t
context
(
TypeDefEntry
tde
)
=
'T'
.
typeRhsRestrictions
$
'T'
.
td_rhs
$
'
CDB
'.
getTypeDef
tde
context
(
ClassEntry
ce
)
=
classContext
ce
context
_
=
[]
function_usages_map
=
make_usage_map
[[(
g
,
idx
)
\\
g
<-
'S'
.
toList
globs
]
\\
idx
<-
fidxs
&
(
fe
,
globs
)
<-
[(
fe
,
'S'
.
newSet
)
\\
FunctionEntry
fe
<-
extra
]
++
function_entries
]
where
fidxs
=
[
idx
\\
(
idx
,
FunctionEntry
_)
<-
entridxs
]
module_usages_map
=
make_usage_map
[[(
i
,
idx
)
\\
i
<-
'S'
.
toList
imps
]
\\
idx
<-
midxs
&
(_,
imps
)
<-
tdb
.
temp_modules
]
where
midxs
=
[
idx
\\
(
idx
,
ModuleEntry
_)
<-
entridxs
]
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
]
entries
=
[
e
\\
Right
e
<-
entries`
]
entries`
=
map
Right
(
extra
++
...
...
@@ -285,26 +307,6 @@ 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
,
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
...
...
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