Commit 33124f23 authored by Camil Staps's avatar Camil Staps 🐧

Add symbolic ranking support (#215)

parent 11aeab8f
Pipeline #16482 passed with stage
in 14 minutes and 9 seconds
...@@ -2,6 +2,7 @@ Clean System Files/ ...@@ -2,6 +2,7 @@ Clean System Files/
builddb builddb
CloogleServer CloogleServer
*.1 *.1
rank_settings.json
types.json types.json
typetree.dot typetree.dot
cloogle.log cloogle.log
......
Subproject commit 3ba4b6698a71e66aabbc8a2a065f5de8f8d57378 Subproject commit 196fee3253b2e55d09fc990b371d2672a7b79134
...@@ -29,14 +29,17 @@ import Data.Maybe ...@@ -29,14 +29,17 @@ import Data.Maybe
import Data.Tuple import Data.Tuple
import System._Posix import System._Posix
import System.CommandLine import System.CommandLine
import System.File
import System.Options import System.Options
import System.Process
import System.Time import System.Time
from Text import class Text(concat,join,toLowerCase), instance Text String, <+ from Text import class Text(concat,join,split,startsWith,toLowerCase), instance Text String, <+
import Text.GenJSON import Text.GenJSON
import Cloogle.API import Cloogle.API
import Cloogle.DB import Cloogle.DB
import Cloogle.Search import Cloogle.Search
import Cloogle.Search.Rank
import Util.SimpleTCPServer import Util.SimpleTCPServer
import Util.Cache import Util.Cache
...@@ -60,8 +63,8 @@ CACHE_NS_THRESHOLD :== 20000000 ...@@ -60,8 +63,8 @@ CACHE_NS_THRESHOLD :== 20000000
, c_page :: Int , c_page :: Int
} }
derive JSONEncode Kind, Type, RequestCacheKey, TypeRestriction derive JSONEncode Kind, Type, RequestCacheKey, TypeRestriction, RankSettings
derive JSONDecode Kind, Type, RequestCacheKey, TypeRestriction derive JSONDecode Kind, Type, RequestCacheKey, TypeRestriction, RankSettings, RankConstraint
instance toString RequestCacheKey instance toString RequestCacheKey
where toString rck = toString $ toJSON rck where toString rck = toString $ toJSON rck
...@@ -114,10 +117,11 @@ where ...@@ -114,10 +117,11 @@ where
unprepareTR (Derivation g t) = Derivation g (unprepare t) unprepareTR (Derivation g t) = Derivation g (unprepare t)
:: Options = :: Options =
{ port :: !Int { port :: !Int
, reload_cache :: !Bool , reload_cache :: !Bool
, test_file :: !Maybe FilePath , rank_settings_constraints :: !Maybe FilePath
, test_options :: ![TestOption] , test_file :: !Maybe FilePath
, test_options :: ![TestOption]
} }
:: TestOption = NoUnify :: TestOption = NoUnify
...@@ -125,10 +129,11 @@ where ...@@ -125,10 +129,11 @@ where
instance zero Options instance zero Options
where where
zero = zero =
{ port = 31215 { port = 31215
, reload_cache = False , reload_cache = False
, test_file = Nothing , rank_settings_constraints = Nothing
, test_options = [] , test_file = Nothing
, test_options = []
} }
optionDescription :: Option Options optionDescription :: Option Options
...@@ -145,6 +150,11 @@ optionDescription = WithHelp True $ Options ...@@ -145,6 +150,11 @@ optionDescription = WithHelp True $ Options
"--reload-cache" "--reload-cache"
(\opts -> Ok {opts & reload_cache=True}) (\opts -> Ok {opts & reload_cache=True})
"Reload the cache in the background" "Reload the cache in the background"
, Option
"--rank-settings-constraints"
(\file opts -> Ok {opts & rank_settings_constraints=Just file})
"FILE"
"Output symbolic rank constraints in Z3 format based on test cases in FILE"
, Option , Option
"--test" "--test"
(\file opts -> Ok {opts & test_file=Just file}) (\file opts -> Ok {opts & test_file=Just file})
...@@ -169,24 +179,21 @@ Start w ...@@ -169,24 +179,21 @@ Start w
#! (_,f,w) = fopen "types.json" FReadText w #! (_,f,w) = fopen "types.json" FReadText w
#! (db,f) = openDB f #! (db,f) = openDB f
#! (ok,db) = isJustU db #! (ok,db) = isJustU db
| not ok | not ok = errexit "Could not open database\n" -1 w
# (io,w) = stdio w #! (_,w) = fclose f w
# io = io <<< "Could not open database\n"
# (_,w) = fclose io w
= w
#! db = hyperstrict (fromJust db) #! db = hyperstrict (fromJust db)
| isJust opts.rank_settings_constraints = computeRankConstraints (fromJust opts.rank_settings_constraints) db w
#! (f,w) = readFile "rank_settings.json" w
# rsets = fromJSON $ fromString $ fromOk f
| isError f || isNothing rsets = errexit "Could not open rank settings\n" -1 w
#! rsets = fromJust rsets
| isJust opts.test_file | isJust opts.test_file
# (ok,f,w) = fopen (fromJust opts.test_file) FReadText w # (ok,f,w) = fopen (fromJust opts.test_file) FReadText w
| not ok | not ok = errexit "Could not open test file\n" -1 w
# (io,w) = stdio w = test opts.test_options rsets f db w
# io = io <<< "Could not open test file\n" #! (db,w) = if opts.reload_cache (doInBackground (reloadCache rsets)) id (db,w)
# (_,w) = fclose io w
= w
= test opts.test_options f db w
#! (db,w) = if opts.reload_cache (doInBackground reloadCache) id (db,w)
#! (_,w) = fclose f w
= serve = serve
{ handler = handle { handler = handle rsets
, logger = Just log , logger = Just log
, port = opts.Options.port , port = opts.Options.port
, connect_timeout = Just 3600000 // 1h , connect_timeout = Just 3600000 // 1h
...@@ -198,13 +205,16 @@ where ...@@ -198,13 +205,16 @@ where
# (ok,w) = mlockall (MCL_CURRENT bitor MCL_FUTURE) w # (ok,w) = mlockall (MCL_CURRENT bitor MCL_FUTURE) w
| ok = w | ok = w
# (err,w) = errno w # (err,w) = errno w
# (io,w) = stdio w = snd $ fclose (stderr <<< "Could not lock memory (" <<< err <<< "); process may get swapped out\n") w
# io = io <<< "Could not lock memory (" <<< err <<< "); process may get swapped out\n"
= snd $ fclose io w errexit :: !String !Int !*World -> *World
errexit msg rcode w
# (_,w) = fclose (stderr <<< msg) w
= setReturnCode rcode w
handle :: !(Maybe Request) !*CloogleDB !*World -> *(!Response, !(!Maybe CacheKey, !MicroSeconds), !*CloogleDB, !*World) handle :: !RankSettings !(Maybe Request) !*CloogleDB !*World -> *(!Response, !(!Maybe CacheKey, !MicroSeconds), !*CloogleDB, !*World)
handle Nothing db w = (err InvalidInput "Couldn't parse input", (Nothing,0), db, w) handle _ Nothing db w = (err InvalidInput "Couldn't parse input", (Nothing,0), db, w)
handle (Just request=:{unify,name,page}) db w handle rsets (Just request=:{unify,name,page}) db w
#! (start,w) = nsTime w #! (start,w) = nsTime w
//Check cache //Check cache
#! (key,db) = toRequestCacheKey db request #! (key,db) = toRequestCacheKey db request
...@@ -222,7 +232,7 @@ handle (Just request=:{unify,name,page}) db w ...@@ -222,7 +232,7 @@ handle (Just request=:{unify,name,page}) db w
= respond start Nothing (err InvalidInput "Empty query") db w = respond start Nothing (err InvalidInput "Empty query") db w
// Results // Results
#! drop_n = fromJust (page <|> pure 0) * MAX_RESULTS #! drop_n = fromJust (page <|> pure 0) * MAX_RESULTS
#! (res,suggs,db) = searchWithSuggestions request db #! (res,suggs,db) = searchWithSuggestions rsets request db
#! suggs = if (isEmpty suggs) Nothing (Just suggs) #! suggs = if (isEmpty suggs) Nothing (Just suggs)
#! results = drop drop_n res #! results = drop drop_n res
#! more = max 0 (length results - MAX_RESULTS) #! more = max 0 (length results - MAX_RESULTS)
...@@ -271,8 +281,8 @@ where ...@@ -271,8 +281,8 @@ where
} }
(give,keep) = splitAt MAX_RESULTS results (give,keep) = splitAt MAX_RESULTS results
reloadCache :: !*(!*CloogleDB, !*World) -> *(!*CloogleDB, !*World) reloadCache :: !RankSettings !*(!*CloogleDB, !*World) -> *(!*CloogleDB, !*World)
reloadCache (db,w) reloadCache rsets (db,w)
# (ks,w) = allCacheKeys LongTerm w # (ks,w) = allCacheKeys LongTerm w
= loop ks db w = loop ks db w
where where
...@@ -280,7 +290,7 @@ where ...@@ -280,7 +290,7 @@ where
loop [] db w = (db,w) loop [] db w = (db,w)
loop [k:ks] db w loop [k:ks] db w
# w = removeFromCache LongTerm k w # w = removeFromCache LongTerm k w
# (_,_,db,w) = handle (Just $ fromRequestCacheKey k) db w # (_,_,db,w) = handle rsets (Just $ fromRequestCacheKey k) db w
# db = resetDB db # db = resetDB db
= loop ks db w = loop ks db w
...@@ -291,8 +301,8 @@ doInBackground f w ...@@ -291,8 +301,8 @@ doInBackground f w
| pid > 0 = w // Parent: return directly | pid > 0 = w // Parent: return directly
| otherwise = snd $ exit 0 $ f w // Child: do function | otherwise = snd $ exit 0 $ f w // Child: do function
test :: ![TestOption] !*File !*CloogleDB !*World -> *World test :: ![TestOption] !RankSettings !*File !*CloogleDB !*World -> *World
test opts queries db w test opts rsets queries db w
# (e,queries) = fend queries # (e,queries) = fend queries
| e = w | e = w
# (qstring,queries) = freadline queries # (qstring,queries) = freadline queries
...@@ -300,17 +310,71 @@ test opts queries db w ...@@ -300,17 +310,71 @@ test opts queries db w
# q = parseSingleLineRequest qstring # q = parseSingleLineRequest qstring
| isError q | isError q
# w = snd $ fclose (stderr <<< "Warning: could not parse '" <<< qstring <<< "'; " <<< fromError q <<< "\n") w # w = snd $ fclose (stderr <<< "Warning: could not parse '" <<< qstring <<< "'; " <<< fromError q <<< "\n") w
= test opts queries db w = test opts rsets queries db w
# q = fromOk q # q = fromOk q
| excluded opts q | excluded opts q
= test opts queries db w = test opts rsets queries db w
# (_,_,db,w) = handle (Just q) db w # (_,_,db,w) = handle rsets (Just q) db w
= test opts queries db w = test opts rsets queries db w
where where
excluded :: ![TestOption] !Request -> Bool excluded :: ![TestOption] !Request -> Bool
excluded [] _ = False excluded [] _ = False
excluded [NoUnify:os] r = isJust r.unify || excluded os r excluded [NoUnify:os] r = isJust r.unify || excluded os r
computeRankConstraints :: !FilePath !*CloogleDB !*World -> *World
computeRankConstraints constraintfile db w
#! (f,w) = readFile constraintfile w
# constraints = fromJSON $ fromString $ fromOk f
| isError f || isNothing constraints = errexit "Could not open rank settings constraints\n" -1 w
# constraints = fromJust constraints
# (constraints,db) = rankConstraints constraints db
# (z3,w) = runProcessIO "z3" ["-in"] Nothing w
| isError z3 = errexit "Failed to run z3\n" -1 w
# (z3h,z3io) = fromOk z3
# z3input = join "\n" (constraints ++ ["(check-sat)","(get-model)","(exit)"]) +++ "\n"
# (err,w) = writePipe z3input z3io.stdIn w
| isError err = errexit "Failed to write constraints to z3\n" -1 w
# (rcode,w) = waitForProcess z3h w
| isError rcode || fromOk rcode <> 0
= errexit
("z3 failed to compute a model with these constraints:\n" +++ z3input)
-1 w
# (out,w) = readPipeBlocking z3io.stdOut w
| isError out = errexit "Failed to read z3 output\n" -1 w
# out = split "\n" $ fromOk out
# settings = findSettings out
{ rs_ngram_distance = 0.0
, rs_exact_result = 0.0
, rs_record_field = 0.0
, rs_constructor = 0.0
, rs_unifier_size = 0.0
, rs_used_synonyms = 0.0
, rs_resolved_context = 0.0
, rs_unresolved_context = 0.0
}
# (io,w) = stdio w
# io = io <<< jsonPrettyPrint (toJSON settings) <<< "\n"
# (_,w) = fclose io w
= w
where
findSettings :: ![String] !RankSettings -> RankSettings
findSettings [s:v:ss] rs
| startsWith " (define-fun " s
# name = s % (14,size s-9) // strip off ' (define-fun ' and ' () Real'
# val = toReal (v % (4,size v-2))
# rs = case name of
"rs_ngram_distance" -> {rs & rs_ngram_distance =val}
"rs_exact_result" -> {rs & rs_exact_result =val}
"rs_record_field" -> {rs & rs_record_field =val}
"rs_constructor" -> {rs & rs_constructor =val}
"rs_unifier_size" -> {rs & rs_unifier_size =val}
"rs_used_synonyms" -> {rs & rs_used_synonyms =val}
"rs_resolved_context" -> {rs & rs_resolved_context =val}
"rs_unresolved_context" -> {rs & rs_unresolved_context=val}
= findSettings ss rs
findSettings [s:ss] rs = findSettings ss rs
findSettings [] rs = rs
:: LogMemory = :: LogMemory =
{ mem_ip :: IPAddress { mem_ip :: IPAddress
, mem_time_start :: Tm , mem_time_start :: Tm
......
#!/bin/bash #!/bin/bash
set -e set -ev
install_clean.sh 'base lib-platform lib-tcpip' 2018-10-30 install_clean.sh 'base lib-platform lib-tcpip' 2018-10-30
PACKAGES="patch jq unzip" PACKAGES="patch jq unzip z3"
apt-get update -qq apt-get update -qq
apt-get install -qq $PACKAGES --no-install-recommends apt-get install -qq $PACKAGES --no-install-recommends
...@@ -11,8 +11,8 @@ make clean CloogleServer builddb ...@@ -11,8 +11,8 @@ make clean CloogleServer builddb
if [ ! -f libs.json ]; then ln -s ../libs.json; fi if [ ! -f libs.json ]; then ln -s ../libs.json; fi
../util/fetch_libs.sh /opt/clean/lib ../util/fetch_libs.sh /opt/clean/lib
echo "./builddb > types.json"
./builddb > types.json ./builddb > types.json
./CloogleServer --rank-settings-constraints rank_settings_constraints.json > rank_settings.json
rm -rf \ rm -rf \
Cloogle \ Cloogle \
......
[ [{"name":"toInt"}, ["LT",["StdOverloaded","toInt"], ["StdChar","digitToInt"]]]
, [{"unify":"Char -> Int"}, ["LT",["StdChar","digitToInt"], ["StdOverloaded","toInt"]]]
, [{"unify":"Int -> String"}, ["LT",["StdOverloaded","fromInt"], ["StdOverloaded","one"]]]
]
...@@ -29,5 +29,11 @@ ...@@ -29,5 +29,11 @@
"text": "<b>SoccerFun</b> users: be aware that to search for things in SoccerFun you need to enable '<b>include apps</b>' in the advanced search options.", "text": "<b>SoccerFun</b> users: be aware that to search for things in SoccerFun you need to enable '<b>include apps</b>' in the advanced search options.",
"from": "Thu, 4 Oct 2018 00:00:00 UTC", "from": "Thu, 4 Oct 2018 00:00:00 UTC",
"until": "Thu, 25 Oct 2018 00:00:00 UTC" "until": "Thu, 25 Oct 2018 00:00:00 UTC"
},
{
"id": "new-ranking",
"text": "Cloogle uses a <a href='https://gitlab.science.ru.nl/cloogle/cloogle-org/merge_requests/216' target='_blank'>new ranking function</a> which needs to learn from its mistakes. Please <a href='https://gitlab.science.ru.nl/cloogle/cloogle-org/issues/new' target='_blank'>report</a> any issues you see.",
"from": "Thu, 15 Nov 2018 00:00:00 UTC",
"until": "Thu, 29 Nov 2018 00:00:00 UTC"
} }
] ]
...@@ -89,6 +89,7 @@ if [[ "$RELEASE_DIRECTORY" != "" ]]; then ...@@ -89,6 +89,7 @@ if [[ "$RELEASE_DIRECTORY" != "" ]]; then
sed 's/\x1b\[[0-9;]*m//g' /tmp/cloogle-build.log \ sed 's/\x1b\[[0-9;]*m//g' /tmp/cloogle-build.log \
| sed -n '/^\.\/builddb /{:a;n;/^Execution: /{p;b};p;ba}' \ | sed -n '/^\.\/builddb /{:a;n;/^Execution: /{p;b};p;ba}' \
> "$THIS_RELEASE/build-log.txt" > "$THIS_RELEASE/build-log.txt"
timeout -k 10 10 sudo docker-compose exec -T backend cat rank_settings.json > "$THIS_RELEASE/rank_settings.json"
timeout -k 10 10 sudo docker-compose exec -T backend cat types.json > "$THIS_RELEASE/types.json" timeout -k 10 10 sudo docker-compose exec -T backend cat types.json > "$THIS_RELEASE/types.json"
timeout -k 10 10 sudo docker-compose exec -T backend cat typetree.dot > "$THIS_RELEASE/typetree.dot" timeout -k 10 10 sudo docker-compose exec -T backend cat typetree.dot > "$THIS_RELEASE/typetree.dot"
fi fi
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment