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.org
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
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Cloogle
cloogle.org
Commits
dea358c4
Verified
Commit
dea358c4
authored
Jun 21, 2017
by
Camil Staps
🚀
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Efficiency improvements
parent
84055873
Changes
8
Hide whitespace changes
Inline
Side-by-side
Showing
8 changed files
with
74 additions
and
40 deletions
+74
-40
backend/Cloogle
backend/Cloogle
+1
-1
backend/CloogleServer.icl
backend/CloogleServer.icl
+39
-27
backend/Makefile
backend/Makefile
+2
-2
backend/Memory.dcl
backend/Memory.dcl
+6
-0
backend/Memory.icl
backend/Memory.icl
+13
-0
backend/SimpleTCPServer.icl
backend/SimpleTCPServer.icl
+1
-1
backend/builddb.icl
backend/builddb.icl
+10
-9
docker-compose.yml
docker-compose.yml
+2
-0
No files found.
Cloogle
@
a07d5e61
Compare
fb0050fc
...
a07d5e61
Subproject commit
fb0050fcc5c53736062093217db0306399c4e958
Subproject commit
a07d5e61ead98df81ecc04a634bcb10748daf555
backend/CloogleServer.icl
View file @
dea358c4
...
...
@@ -19,20 +19,22 @@ from Data.Func import $
import
Data
.
Functor
import
Data
.
List
import
Data
.
Tuple
import
System
.
_Posix
import
System
.
CommandLine
import
System
.
Time
from
Text
import
class
Text
(
concat
),
instance
Text
String
import
Text
.
JSON
import
System
.
Time
from
SimpleTCPServer
import
::
LogMessage
{..},
serve
,
::
Logger
import
qualified
SimpleTCPServer
import
Cache
import
Cloogle
import
Type
import
TypeDB
import
Search
from
SimpleTCPServer
import
::
LogMessage
{..},
serve
,
::
Logger
import
qualified
SimpleTCPServer
import
Cache
import
Memory
MAX_RESULTS
:==
15
CACHE_PREFETCH
:==
5
...
...
@@ -66,27 +68,37 @@ toRequestCacheKey r =
}
Start
w
#
(
io
,
w
)
=
stdio
w
#
(
cmdline
,
w
)
=
getCommandLine
w
|
length
cmdline
<>
2
=
help
io
w
|
length
cmdline
<>
2
=
help
w
#
[_,
port
:_]
=
cmdline
#
port
=
toInt
port
#
(
db
,
io
)
=
openDb
io
#
(_,
w
)
=
fclose
io
w
|
isNothing
db
=
abort
"stdin does not have a TypeDB
\n
"
#!
db
=
fromJust
db
=
serve
(
handle
db
)
(
Just
log
)
port
w
#
w
=
disableSwap
w
#
!
(_,
f
,
w
)
=
fopen
"types.json"
FReadText
w
#
!
(
db
,
f
)
=
openDb
f
#!
db
=
evalDb
db
#!
(_,
w
)
=
fclose
f
w
=
serve
(
handle
db
)
(
Just
log
)
(
toInt
port
)
w
where
help
::
*
File
*
World
->
*
World
help
io
w
help
::
*
World
->
*
World
help
w
#
(
io
,
w
)
=
stdio
w
#
io
=
io
<<<
"Usage: ./CloogleServer <port>
\n
"
=
snd
$
fclose
io
w
disableSwap
::
*
World
->
*
World
disableSwap
w
#
(
ok
,
w
)
=
mlockall
(
MCL_CURRENT
bitor
MCL_FUTURE
)
w
|
ok
=
w
#
(
err
,
w
)
=
errno
w
#
(
io
,
w
)
=
stdio
w
#
io
=
io
<<<
"Could not lock memory ("
<<<
err
<<<
"); process may get swapped out
\n
"
=
snd
$
fclose
io
w
handle
::
!
TypeDB
!(
Maybe
Request
)
!*
World
->
*(!
Response
,
CacheKey
,
!*
World
)
handle
_
Nothing
w
=
(
err
InvalidInput
"Couldn't parse input"
,
""
,
w
)
handle
db
Nothing
w
=
(
err
InvalidInput
"Couldn't parse input"
,
""
,
w
)
handle
db
(
Just
request
=:{
unify
,
name
,
page
})
w
//Check cache
#
(
mbResponse
,
w
)
=
readCache
key
w
#
!
(
mbResponse
,
w
)
=
readCache
key
w
|
isJust
mbResponse
#
r
=
fromJust
mbResponse
=
({
r
&
return
=
if
(
r
.
return
==
0
)
1
r
.
return
},
cacheKey
key
,
w
)
...
...
@@ -97,22 +109,22 @@ where
|
isJust
unify
&&
isNothing
(
parseType
$
fromString
$
fromJust
unify
)
=
respond
(
err
InvalidType
"Couldn't parse type"
)
w
// Results
#
drop_n
=
fromJust
(
page
<|>
pure
0
)
*
MAX_RESULTS
#
results
=
drop
drop_n
$
sort
$
search
request
db
#
more
=
max
0
(
length
results
-
MAX_RESULTS
)
#
!
drop_n
=
fromJust
(
page
<|>
pure
0
)
*
MAX_RESULTS
#
!
results
=
drop
drop_n
$
sort
$
search
request
db
#
!
more
=
max
0
(
length
results
-
MAX_RESULTS
)
// Suggestions
#
mbType
=
unify
>>=
parseType
o
fromString
#
suggestions
=
mbType
>>=
flip
(
suggs
name
)
db
#
w
=
seq
[
cachePages
#
!
mbType
=
unify
>>=
parseType
o
fromString
#
!
suggestions
=
mbType
>>=
flip
(
suggs
name
)
db
#
!
w
=
seq
[
cachePages
(
toRequestCacheKey
req
)
CACHE_PREFETCH
0
zero
suggs
\\
(
req
,
suggs
)
<-
'
Foldable
'.
concat
suggestions
]
w
#
suggestions
#
!
suggestions
=
sortBy
(\
a
b
->
snd
a
>
snd
b
)
<$>
filter
((<)
(
length
results
)
o
snd
)
<$>
map
(
appSnd
length
)
<$>
suggestions
#
(
results
,
nextpages
)
=
splitAt
MAX_RESULTS
results
#
!
(
results
,
nextpages
)
=
splitAt
MAX_RESULTS
results
// Response
#
response
=
if
(
isEmpty
results
)
#
!
response
=
if
(
isEmpty
results
)
(
err
NoResults
"No results"
)
{
zero
&
data
=
results
...
...
@@ -120,7 +132,7 @@ where
,
suggestions
=
suggestions
}
// Save page prefetches
#
w
=
cachePages
key
CACHE_PREFETCH
1
response
nextpages
w
#
!
w
=
cachePages
key
CACHE_PREFETCH
1
response
nextpages
w
// Save cache file
=
respond
response
w
where
...
...
backend/Makefile
View file @
dea358c4
...
...
@@ -2,7 +2,7 @@ BIN:=CloogleServer builddb
DB
=
types.json
MAN
:=
builddb.1
# Others don't have --help/--version #
$(
addsuffix
.1,
$(BIN)
)
CLM
:=
clm
CLMFLAGS
:=
-dynamics
-h
2
5
0M
-nr
-nt
\
CLMFLAGS
:=
-dynamics
-h
2
0
0M
-nr
-nt
\
-I
$$
CLEAN_HOME/lib/ArgEnv
\
-I
$$
CLEAN_HOME/lib/Dynamics
\
-I
$$
CLEAN_HOME/lib/Generics
\
...
...
@@ -42,7 +42,7 @@ $(BIN): clean-compiler .FORCE
$(CLM)
$(CLMFLAGS)
$@
-o
$@
$(DB)
:
builddb
./
$<
>
$(DB)
./
$<
-s
10M
-h
250M
>
$(DB)
clean
:
$(RM)
-r
'Clean System Files'
$(BIN)
$(MAN)
$(DB)
...
...
backend/Memory.dcl
0 → 100644
View file @
dea358c4
definition
module
Memory
MCL_CURRENT
:==
1
MCL_FUTURE
:==
2
mlockall
::
!
Int
!*
World
->
*(!
Bool
,
!*
World
)
backend/Memory.icl
0 → 100644
View file @
dea358c4
implementation
module
Memory
import
StdInt
mlockall
::
!
Int
!*
World
->
*(!
Bool
,
!*
World
)
mlockall
flags
w
#
(
res
,
w
)
=
lock
flags
w
=
(
res
==
0
,
w
)
where
lock
::
!
Int
!*
World
->
*(!
Int
,
!*
World
)
lock
flags
w
=
code {
ccall
mlockall
"I:I:A"
}
backend/SimpleTCPServer.icl
View file @
dea358c4
...
...
@@ -30,7 +30,7 @@ where
#!
(
st
,
w
)
=
log
(
Connected
ip
)
Nothing
w
=
handle
f
log
st
dupChan
w
// Child: handle current request
handle
::
(
a
*
World
->
(
b
,
t
,*
World
))
(
Logger
a
b
s
t
)
!(
Maybe
!
s
)
!
TCP_DuplexChannel
handle
::
(
a
*
World
->
(
b
,
t
,*
World
))
(
Logger
a
b
s
t
)
!(
Maybe
s
)
!
TCP_DuplexChannel
!*
World
->
(
TCP_Listener
,
*
World
)
|
fromString
a
&
toString
b
handle
f
log
st
dupChannel
=:{
rChannel
,
sChannel
}
w
#
(
tRep
,
msg
,
rChannel
,
w
)
=
receive_MT
TIMEOUT
rChannel
w
...
...
backend/builddb.icl
View file @
dea358c4
...
...
@@ -73,6 +73,7 @@ USAGE :== concat [
"
\t
-r PATH Change the library root to PATH
\n
"
,
"
\t
-l PATH Add PATH to the librarypaths relative to the root
\n
"
]
Start
::
*
World
->
*
World
Start
w
#
(
args
,
w
)
=
getCommandLine
w
#
(
f
,
w
)
=
stdio
w
...
...
@@ -83,12 +84,12 @@ Start w
|
cli
.
version
=
fclose
(
f
<<<
VERSION
)
w
#
(
modss
,
w
)
=
mapSt
(
flip
(
uncurry
$
findModules
cli
.
exclude
cli
.
root
)
""
)
cli
.
libs
w
#
mods
=
flatten
modss
#
(
db
,
w
)
=
loop
cli
.
root
mods
newDb
w
#
db
=
putFunctions
predefFunctions
db
#
db
=
putClasses
predefClasses
db
#
db
=
putTypes
predefTypes
db
#
db
=
putFunctions
(
flatten
$
map
constructor_functions
predefTypes
)
db
#
db
=
putFunctions
(
flatten
$
map
record_functions
predefTypes
)
db
#
!
(
db
,
w
)
=
loop
cli
.
root
mods
newDb
w
#
!
db
=
putFunctions
predefFunctions
db
#
!
db
=
putClasses
predefClasses
db
#
!
db
=
putTypes
predefTypes
db
#
!
db
=
putFunctions
(
flatten
$
map
constructor_functions
predefTypes
)
db
#
!
db
=
putFunctions
(
flatten
$
map
record_functions
predefTypes
)
db
#
io
=
stderr
#
io
=
printStats
db
io
#
(
ok1
,
w
)
=
fclose
io
w
...
...
@@ -98,11 +99,11 @@ Start w
|
not
ok
=
abort
"Couldn't close stdio"
=
w
where
loop
::
String
[(
String
,
String
,
Bool
)]
TypeDB
*
World
->
*(
TypeDB
,
*
World
)
loop
::
String
[(
String
,
String
,
Bool
)]
!
TypeDB
!*
World
->
*(!
TypeDB
,
!
*
World
)
loop
_
[]
db
w
=
(
db
,
w
)
loop
root
[(
lib
,
mod
,
iscore
):
list
]
db
w
#
w
=
snd
(
fclose
(
stderr
<<<
lib
<<<
": "
<<<
mod
<<<
"
\n
"
)
w
)
#
(
db
,
w
)
=
getModuleTypes
root
mod
lib
iscore
db
w
#
!
w
=
snd
(
fclose
(
stderr
<<<
lib
<<<
": "
<<<
mod
<<<
"
\n
"
)
w
)
#
!
(
db
,
w
)
=
getModuleTypes
root
mod
lib
iscore
db
w
=
loop
root
list
db
w
parseCLI
::
[
String
]
->
Either
String
CLI
...
...
docker-compose.yml
View file @
dea358c4
...
...
@@ -8,6 +8,8 @@ services:
-
"
./cloogle.log:/usr/src/cloogle/cloogle.log"
-
"
./cache:/usr/src/cloogle/cache"
restart
:
always
cap_add
:
-
IPC_LOCK
frontend
:
build
:
frontend
...
...
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