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
57e7845f
Commit
57e7845f
authored
Jan 02, 2017
by
Camil Staps
🚀
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
More implementation module locations
parent
9efa92eb
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
78 additions
and
73 deletions
+78
-73
CloogleServer.icl
CloogleServer.icl
+21
-21
TypeDB.dcl
TypeDB.dcl
+2
-3
TypeDB.icl
TypeDB.icl
+7
-20
builddb.icl
builddb.icl
+48
-29
No files found.
CloogleServer.icl
View file @
57e7845f
...
...
@@ -83,7 +83,7 @@ import Cache
,
macro_representation
::
String
}
::
LocationResult
:==
(
String
,
String
,
Maybe
Int
)
::
LocationResult
:==
(
String
,
String
,
Maybe
Int
,
Maybe
Int
)
::
StrUnifier
:==
([(
String
,
String
)],
[(
String
,
String
)])
...
...
@@ -251,12 +251,12 @@ where
#
macros
=
map
(\(
lhs
,
rhs
)
->
makeMacroResult
name
lhs
rhs
)
macros
// Search class members
#
filts
=
catMaybes
[
(\
t
_
_
_
_->
isUnifiable
t
)
<$>
mbType
,
(\
n
(
Location
lib
mod
_
_)
_
_
f
_
->
isNameMatch
(
size
n
*
2
/
3
)
n
(
Location
lib
mod
Nothing
f
))
<$>
name
,
(\
n
(
Location
lib
mod
_
_
_
)
_
_
f
_
->
isNameMatch
(
size
n
*
2
/
3
)
n
(
Location
lib
mod
Nothing
Nothing
f
))
<$>
name
]
#
members
=
findClassMembers``
filts
db
#
members
=
map
(\(
Location
lib
mod
line
cls
,
vs
,_,
f
,
et
)
->
makeFunctionResult
name
mbType
(
Just
{
cls_name
=
cls
,
cls_vars
=
vs
})
(
Location
lib
mod
line
f
,
et
)
db
)
members
#
members
=
map
(\(
Location
lib
mod
line
iclline
cls
,
vs
,_,
f
,
et
)
->
makeFunctionResult
name
mbType
(
Just
{
cls_name
=
cls
,
cls_vars
=
vs
})
(
Location
lib
mod
line
iclline
f
,
et
)
db
)
members
// Search types
#
lcName
=
if
(
isJust
mbType
&&
isType
(
fromJust
mbType
))
(
let
(
Type
name
_)
=
fromJust
mbType
in
Just
$
toLowerCase
name
)
...
...
@@ -287,12 +287,12 @@ where
}
,
makeClassResultExtras
rec
db
)
makeClassResult
rec
=:(
Location
lib
mod
line
cls
,
vars
,
cc
,
funs
)
db
makeClassResult
rec
=:(
Location
lib
mod
line
iclline
cls
,
vars
,
cc
,
funs
)
db
=
ClassResult
(
{
library
=
lib
,
filename
=
modToFilename
mod
,
dcl_line
=
line
,
icl_line
=
Nothing
,
icl_line
=
iclline
,
modul
=
mod
,
distance
=
-100
,
builtin
=
Nothing
...
...
@@ -314,19 +314,19 @@ where
where
cls
=
case
l
of
Builtin
c
=
c
Location
_
_
_
c
=
c
Location
_
_
_
_
c
=
c
print_fun
::
(
Name
,
ExtendedType
)
->
String
print_fun
f
=:(_,
ET
_
et
)
=
fromJust
$
et
.
te_representation
<|>
(
pure
$
concat
$
print
False
f
)
makeTypeResult
::
(
Maybe
String
)
Location
TypeDef
TypeDB
->
Result
makeTypeResult
mbName
(
Location
lib
mod
line
t
)
td
db
makeTypeResult
mbName
(
Location
lib
mod
line
iclline
t
)
td
db
=
TypeResult
(
{
library
=
lib
,
filename
=
modToFilename
mod
,
dcl_line
=
line
,
icl_line
=
line
,
icl_line
=
icl
line
,
modul
=
mod
,
distance
=
if
(
isNothing
mbName
)
-100
(
levenshtein`
t
(
fromJust
mbName
))
...
...
@@ -357,12 +357,12 @@ where
)
makeMacroResult
::
(
Maybe
String
)
Location
Macro
->
Result
makeMacroResult
mbName
(
Location
lib
mod
line
m
)
mac
makeMacroResult
mbName
(
Location
lib
mod
line
iclline
m
)
mac
=
MacroResult
(
{
library
=
lib
,
filename
=
modToFilename
mod
,
dcl_line
=
line
,
icl_line
=
Nothing
,
icl_line
=
iclline
,
modul
=
mod
,
distance
=
if
(
isNothing
mbName
)
-100
(
levenshtein`
(
fromJust
mbName
)
m
)
...
...
@@ -381,7 +381,7 @@ where
(
{
library
=
lib
,
filename
=
modToFilename
mod
,
dcl_line
=
line
,
icl_line
=
tes
.
te_
iclline
,
icl_line
=
iclline
,
modul
=
mod
,
distance
=
distance
,
builtin
=
builtin
...
...
@@ -405,9 +405,9 @@ where
}
)
where
(
lib
,
mod
,
fname
,
line
,
builtin
)
=
case
fl
of
(
Location
l
m
ln
f
)
=
(
l
,
m
,
f
,
ln
,
Nothing
)
(
Builtin
f
)
=
(
""
,
""
,
f
,
Nothing
,
Just
True
)
(
lib
,
mod
,
fname
,
line
,
iclline
,
builtin
)
=
case
fl
of
(
Location
l
m
ln
iln
f
)
=
(
l
,
m
,
f
,
ln
,
iln
,
Nothing
)
(
Builtin
f
)
=
(
""
,
""
,
f
,
Nothing
,
Nothing
,
Just
True
)
toStrUnifier
::
Unifier
->
StrUnifier
toStrUnifier
(
tvas1
,
tvas2
)
=
(
map
toStr
tvas1
,
map
toStr
tvas2
)
...
...
@@ -454,15 +454,15 @@ where
=
n1
==
""
||
indexOf
n1
n2
<>
-1
||
levenshtein
[
c
\\
c
<-:
n1
]
[
c
\\
c
<-:
n2
]
<=
maxdist
isModMatch
::
![
String
]
Location
->
Bool
isModMatch
mods
(
Location
_
mod
_
_)
=
isMember
mod
mods
isModMatch
_
(
Builtin
_)
=
False
isModMatch
mods
(
Location
_
mod
_
_
_
)
=
isMember
mod
mods
isModMatch
_
(
Builtin
_)
=
False
isLibMatch
::
(![
String
],
!
Bool
)
Location
->
Bool
isLibMatch
(
libs
,_)
(
Location
lib
_
_
_)
=
any
(\
l
->
indexOf
l
lib
==
0
)
libs
isLibMatch
(_,
blti
)
(
Builtin
_)
=
blti
isLibMatch
(
libs
,_)
(
Location
lib
_
_
_
_
)
=
any
(\
l
->
indexOf
l
lib
==
0
)
libs
isLibMatch
(_,
blti
)
(
Builtin
_)
=
blti
loc
::
Location
->
LocationResult
loc
(
Location
lib
mod
ln
_)
=
(
lib
,
mod
,
ln
)
loc
(
Location
lib
mod
ln
iln
_)
=
(
lib
,
mod
,
ln
,
i
ln
)
log
::
(
LogMessage
(
Maybe
Request
)
Response
CacheKey
)
IPAddress
*
World
->
*(
IPAddress
,
*
World
)
...
...
TypeDB.dcl
View file @
57e7845f
...
...
@@ -20,7 +20,6 @@ from Type import ::Type, ::TypeVar, ::TVAssignment, ::TypeDef, class print(..),
,
te_isrecordfield
::
Bool
,
te_generic_vars
::
Maybe
[
TypeVar
]
,
te_representation
::
Maybe
String
,
te_iclline
::
Maybe
Int
}
::
ExtendedType
=
ET
Type
TypeExtras
...
...
@@ -29,8 +28,8 @@ from Type import ::Type, ::TypeVar, ::TVAssignment, ::TypeDef, class print(..),
,
macro_extras
::
TypeExtras
}
::
Location
=
Location
Library
Module
LineNr
Name
|
Builtin
Name
::
Location
=
Location
Library
Module
LineNr
LineNr
Name
|
Builtin
Name
::
Name
:==
String
::
Library
:==
String
...
...
TypeDB.icl
View file @
57e7845f
...
...
@@ -55,24 +55,12 @@ where
,
derivemap`
=
newMap
}
instance
<
(
Maybe
a
)
|
<
a
where
(<)
(
Just
a
)
(
Just
b
)
=
a
<
b
(<)
(
Just
_)
Nothing
=
True
(<)
Nothing
_
=
False
instance
<
Location
where
(<)
(
Location
a
b
c
d
)
(
Location
e
f
g
h
)
=
((
a
,
b
),(
c
,
d
))
<
((
e
,
f
),(
g
,
h
))
(<)
(
Location
_
_
_
_)
(
Builtin
_)
=
True
(<)
(
Builtin
_)
(
Location
_
_
_
_)
=
False
(<)
(
Builtin
a
)
(
Builtin
b
)
=
a
<
b
derive
gLexOrd
Maybe
,
ClassOrGeneric
,
Kind
,
Type
derive
gLexOrd
Location
,
Maybe
,
ClassOrGeneric
,
Kind
,
Type
instance
<
Location
where
(<)
a
b
=
(
a
=?=
b
)
===
LT
instance
<
(
Maybe
a
)
|
gLexOrd
{|*|}
a
where
(<)
a
b
=
(
a
=?=
b
)
===
LT
instance
<
Type
where
(<)
a
b
=
(
a
=?=
b
)
===
LT
instance
<
(
a
,
b
,
c
,
d
)
|
Ord
a
&
Ord
b
&
Ord
c
&
Ord
d
where
(<)
(
a
,
b
,
c
,
d
)
(
e
,
f
,
g
,
h
)
=
((
a
,
b
),(
c
,
d
))
<
((
e
,
f
),(
g
,
h
))
instance
<
(
a
,
b
,
c
,
d
)
|
gLexOrd
{|*|}
a
&
gLexOrd
{|*|}
b
&
gLexOrd
{|*|}
c
&
gLexOrd
{|*|}
d
where
(<)
a
b
=
(
a
=?=
b
)
===
LT
instance
==
Location
where
...
...
@@ -85,7 +73,6 @@ where
,
te_isrecordfield
=
False
,
te_generic_vars
=
Nothing
,
te_representation
=
Nothing
,
te_iclline
=
Nothing
}
instance
print
TypeExtras
...
...
@@ -106,8 +93,8 @@ where
|
otherwise
=
f
getName
::
Location
->
Name
getName
(
Location
_
_
_
name
)
=
name
getName
(
Builtin
name
)
=
name
getName
(
Location
_
_
_
_
name
)
=
name
getName
(
Builtin
name
)
=
name
functionCount
::
TypeDB
->
Int
functionCount
{
functionmap
}
=
mapSize
functionmap
...
...
builddb.icl
View file @
57e7845f
...
...
@@ -37,7 +37,7 @@ from syntax import ::SymbolTable, ::SymbolTableEntry, ::Ident{..}, ::SymbolPtr,
::
FunSpecials
,
::
Priority
,
::
ParsedModule
,
::
SymbolType
,
::
ParsedInstanceAndMembers
{..},
::
ParsedInstance
{
pi_ident
,
pi_pos
,
pi_types
},
::
Type
,
::
ClassDef
{
class_ident
,
class_pos
,
class_args
,
class_context
},
::
TypeVar
,
::
ParsedTypeDef
,
::
TypeDef
{
td_pos
},
::
TypeVar
,
::
ParsedTypeDef
,
::
TypeDef
{
td_pos
,
td_ident
},
::
GenericDef
{
gen_ident
,
gen_pos
,
gen_type
,
gen_vars
},
::
GenericCaseDef
{
gc_type
,
gc_pos
,
gc_gcf
},
::
GenericCaseFunctions
(
GCF
),
::
GCF
,
::
FunKind
(
FK_Macro
),
...
...
@@ -234,12 +234,13 @@ getModuleTypes :: String String String *DclCache 'DB'.TypeDB *World -> *('DB'.Ty
getModuleTypes
root
mod
lib
cache
db
w
#
(
Right
dcl
,
cache
,
w
)
=
readModule
False
cache
w
#
(
icl
,
cache
,
w
)
=
readModule
True
cache
w
#
icl
=
case
icl
of
(
Left
_)
=
Nothing
;
(
Right
x
)
=
Just
x
#
mod
=
dcl
.
mod_ident
.
id_name
#
lib
=
cleanlib
mod
lib
#
db
=
'
DB
'.
putFunctions
(
pd_typespecs
lib
mod
dcl
.
mod_defs
icl
)
db
#
db
=
'
DB
'.
putInstances
(
pd_instances
lib
mod
dcl
.
mod_defs
)
db
#
db
=
'
DB
'.
putInstances
(
pd_instances
lib
mod
dcl
.
mod_defs
icl
)
db
#
db
=
'
DB
'.
putClasses
(
pd_classes
lib
mod
dcl
.
mod_defs
icl
)
db
#
typedefs
=
pd_types
lib
mod
dcl
.
mod_defs
#
typedefs
=
pd_types
lib
mod
dcl
.
mod_defs
icl
#
db
=
'
DB
'.
putTypes
typedefs
db
#
db
=
'
DB
'.
putFunctions
(
flatten
$
map
constructor_functions
typedefs
)
db
#
db
=
'
DB
'.
putFunctions
(
flatten
$
map
record_functions
typedefs
)
db
...
...
@@ -264,7 +265,7 @@ where
pd_macros
::
String
String
[
ParsedDefinition
]
->
[('
DB
'.
Location
,
'
DB
'.
Macro
)]
pd_macros
lib
mod
dcl
=
[(
'
DB
'.
Location
lib
mod
(
toLine
pos
)
id
.
id_name
=
[(
'
DB
'.
Location
lib
mod
(
toLine
pos
)
Nothing
id
.
id_name
,
{
macro_as_string
=
priostring
id
+++
cpp
pd
,
macro_extras
=
{
zero
&
te_priority
=
findPrio
id
>>=
'T'
.
toMaybePriority
}
}
...
...
@@ -288,65 +289,83 @@ where
->
[('
DB
'.
Name
,
[('
DB
'.
Type
,
'
DB
'.
Location
)])]
pd_derivations
lib
mod
dcl
=
[(
id
.
id_name
,
[(
'T'
.
toType
gc_type
,
'
DB
'.
Location
lib
mod
(
toLine
gc_pos
)
""
)]
,
[(
'T'
.
toType
gc_type
,
'
DB
'.
Location
lib
mod
(
toLine
gc_pos
)
Nothing
""
)]
)
\\
PD_Derive
gcdefs
<-
dcl
,
{
gc_type
,
gc_pos
,
gc_gcf
=
GCF
id
_}
<-
gcdefs
]
pd_generics
::
String
String
[
ParsedDefinition
]
->
[('
DB
'.
Location
,
'
DB
'.
ExtendedType
)]
pd_generics
lib
mod
dcl
=
[(
'
DB
'.
Location
lib
mod
(
toLine
gen_pos
)
id_name
=
[(
'
DB
'.
Location
lib
mod
(
toLine
gen_pos
)
Nothing
id_name
,
'
DB
'.
ET
(
'T'
.
toType
gen_type
)
{
zero
&
te_generic_vars
=
Just
$
map
'T'
.
toTypeVar
gen_vars
,
te_representation
=
Just
$
cpp
gen
}
)
\\
gen
=:(
PD_Generic
{
gen_ident
={
id_name
},
gen_pos
,
gen_type
,
gen_vars
})
<-
dcl
]
pd_typespecs
::
String
String
[
ParsedDefinition
]
(
Either
String
ParsedModule
)
pd_typespecs
::
String
String
[
ParsedDefinition
]
(
Maybe
ParsedModule
)
->
[('
DB
'.
Location
,
'
DB
'.
ExtendedType
)]
pd_typespecs
lib
mod
dcl
icl
=
[(
'
DB
'.
Location
lib
mod
(
toLine
pos
)
id_name
=
[(
'
DB
'.
Location
lib
mod
(
toLine
pos
)
(
findIclLine
id_name
=<<
icl
)
id_name
,
'
DB
'.
ET
(
'T'
.
toType
t
)
{
zero
&
te_priority
=
'T'
.
toMaybePriority
p
,
te_representation
=
Just
$
cpp
ts
,
te_iclline
=
findIclLine
id_name
icl
}
,
te_representation
=
Just
$
cpp
ts
}
)
\\
ts
=:(
PD_TypeSpec
pos
id
=:{
id_name
}
p
(
Yes
t
)
funspecs
)
<-
dcl
]
where
findIclLine
::
String
(
Either
String
ParsedModule
)
->
Maybe
Int
findIclLine
_
(
Left
_)
=
Nothing
findIclLine
name
(
Right
{
mod_defs
=
pms
})
findIclLine
::
String
ParsedModule
->
Maybe
Int
findIclLine
name
{
mod_defs
=
pms
}
=
case
[
pos
\\
PD_TypeSpec
pos
id
_
_
_
<-
pms
|
id
.
id_name
==
name
]
of
[
FunPos
_
l
_:_]
=
Just
l
[
LinePos
_
l
:_]
=
Just
l
_
=
Nothing
pd_instances
::
String
String
[
ParsedDefinition
]
pd_instances
::
String
String
[
ParsedDefinition
]
(
Maybe
ParsedModule
)
->
[('
DB
'.
Class
,
['
DB
'.
Type
],
'
DB
'.
Location
)]
pd_instances
lib
mod
dcl
=
[(
pi_ident
.
id_name
pd_instances
lib
mod
dcl
icl
=
[(
id_name
,
map
'T'
.
toType
pi_types
,
'
DB
'.
Location
lib
mod
(
toLine
pi_pos
)
""
)
\\
PD_Instance
{
pim_pi
={
pi_ident
,
pi_types
,
pi_pos
}}
<-
dcl
]
,
'
DB
'.
Location
lib
mod
(
toLine
pi_pos
)
(
findIclLine
id_name
=<<
icl
)
""
)
\\
PD_Instance
{
pim_pi
={
pi_ident
={
id_name
},
pi_types
,
pi_pos
}}
<-
dcl
]
where
findIclLine
::
String
ParsedModule
->
Maybe
Int
findIclLine
name
{
mod_defs
=
pms
}
=
case
[
pi_pos
\\
PD_Instance
{
pim_pi
={
pi_pos
,
pi_ident
}}
<-
pms
|
pi_ident
.
id_name
==
name
]
of
[
LinePos
_
l
:_]
=
Just
l
_
=
Nothing
pd_classes
::
String
String
[
ParsedDefinition
]
(
Either
String
ParsedModule
)
pd_classes
::
String
String
[
ParsedDefinition
]
(
Maybe
ParsedModule
)
->
[('
DB
'.
Location
,
[
'T'
.
TypeVar
],
'T'
.
ClassContext
,
[('
DB
'.
Name
,
'
DB
'.
ExtendedType
)])]
pd_classes
lib
mod
dcl
icl
#
dcl
=
filter
(\
pd
->
case
pd
of
(
PD_Class
_
_)=
True
;
_=
False
)
dcl
=
map
(\(
PD_Class
{
class_ident
={
id_name
},
class_pos
,
class_args
,
class_context
}
dcl
)
->
let
typespecs
=
pd_typespecs
lib
mod
dcl
icl
in
('
DB
'.
Location
lib
mod
(
toLine
class_pos
)
id_name
,
map
'T'
.
toTypeVar
class_args
,
flatten
$
map
'T'
.
toClassContext
class_context
,
[(
f
,
et
)
\\
('
DB
'.
Location
_
_
_
f
,
et
)
<-
typespecs
]))
dcl
in
('
DB
'.
Location
lib
mod
(
toLine
class_pos
)
(
findIclLine
id_name
=<<
icl
)
id_name
,
map
'T'
.
toTypeVar
class_args
,
flatten
$
map
'T'
.
toClassContext
class_context
,
[(
f
,
et
)
\\
('
DB
'.
Location
_
_
_
_
f
,
et
)
<-
typespecs
]))
dcl
where
findIclLine
::
String
ParsedModule
->
Maybe
Int
findIclLine
name
{
mod_defs
=
pms
}
=
case
[
class_pos
\\
PD_Class
{
class_ident
,
class_pos
}
_
<-
pms
|
class_ident
.
id_name
==
name
]
of
[
LinePos
_
l
:_]
=
Just
l
_
=
Nothing
pd_types
::
String
String
[
ParsedDefinition
]
pd_types
::
String
String
[
ParsedDefinition
]
(
Maybe
ParsedModule
)
->
[('
DB
'.
Location
,
'
DB
'.
TypeDef
)]
pd_types
lib
mod
dcl
=
[('
DB
'.
Location
lib
mod
(
toLine
ptd
.
td_pos
)
(
'T'
.
td_name
td
),
td
)
pd_types
lib
mod
dcl
icl
=
[
let
name
=
'T'
.
td_name
td
in
('
DB
'.
Location
lib
mod
(
toLine
ptd
.
td_pos
)
(
findIclLine
name
=<<
icl
)
name
,
td
)
\\
PD_Type
ptd
<-
dcl
,
td
<-
[
'T'
.
toTypeDef
ptd
]]
where
findIclLine
::
String
ParsedModule
->
Maybe
Int
findIclLine
name
{
mod_defs
=
pms
}
=
case
[
td_pos
\\
PD_Type
{
td_ident
,
td_pos
}
<-
pms
|
td_ident
.
id_name
==
name
]
of
[
LinePos
_
l
:_]
=
Just
l
_
=
Nothing
constructor_functions
::
('
DB
'.
Location
,
'
DB
'.
TypeDef
)
->
[('
DB
'.
Location
,
'
DB
'.
ExtendedType
)]
constructor_functions
('
DB
'.
Location
lib
mod
line
_,
td
)
=
[('
DB
'.
Location
lib
mod
line
c
,
'
DB
'.
ET
f
constructor_functions
('
DB
'.
Location
lib
mod
line
iclline
_,
td
)
=
[('
DB
'.
Location
lib
mod
line
iclline
c
,
'
DB
'.
ET
f
{
zero
&
te_isconstructor
=
True
,
te_representation
=
Just
$
concat
$
[
c
]
++
print_prio
p
++
[
" :: "
]
++
print
False
f
...
...
@@ -359,8 +378,8 @@ where
record_functions
::
('
DB
'.
Location
,
'
DB
'.
TypeDef
)
->
[('
DB
'.
Location
,
'
DB
'.
ExtendedType
)]
record_functions
('
DB
'.
Location
lib
mod
line
_,
td
)
=
[('
DB
'.
Location
lib
mod
line
f
,
'
DB
'.
ET
t
record_functions
('
DB
'.
Location
lib
mod
line
iclline
_,
td
)
=
[('
DB
'.
Location
lib
mod
line
iclline
f
,
'
DB
'.
ET
t
{
zero
&
te_isrecordfield
=
True
,
te_representation
=
Just
$
concat
$
[
"."
,
f
,
" :: "
:
print
False
t
]})
\\
(
f
,
t
)
<-
'T'
.
recordsToFunctions
td
]
...
...
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