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
196fee32
Verified
Commit
196fee32
authored
Nov 15, 2018
by
Camil Staps
🚀
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Add support for symbolic ranking (
cloogle-org#215
)
parent
3ba4b669
Changes
5
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
285 additions
and
96 deletions
+285
-96
Cloogle/DB.icl
Cloogle/DB.icl
+3
-3
Cloogle/Search.dcl
Cloogle/Search.dcl
+20
-4
Cloogle/Search.icl
Cloogle/Search.icl
+88
-89
Cloogle/Search/Rank.dcl
Cloogle/Search/Rank.dcl
+52
-0
Cloogle/Search/Rank.icl
Cloogle/Search/Rank.icl
+122
-0
No files found.
Cloogle/DB.icl
View file @
196fee32
...
...
@@ -50,9 +50,9 @@ import Cloogle.API
instance
==
AnnotationKey
where
==
NGramDistance
NGramDistance
=
True
==
UnifierSize
UnifierSize
=
True
==
_
_
=
False
==
NGramDistance
k
=
k
=:
NGramDistance
==
UnifierSize
k
=
k
=:
UnifierSize
==
ExactResult
k
=
k
=:
ExactResult
derive
gLexOrd
AnnotationKey
instance
<
AnnotationKey
where
<
a
b
=
(
a
=?=
b
)
===
LT
...
...
Cloogle/Search.dcl
View file @
196fee32
...
...
@@ -4,9 +4,14 @@ definition module Cloogle.Search
* Search functions for the Cloogle system
*/
from
Clean
.
Types
import
::
TypeDef
,
::
Type
,
::
Unifier
from
Database
.
Native
import
::
NativeDB
from
Cloogle
.
API
import
::
Request
,
::
Result
from
Cloogle
.
DB
import
::
CloogleDB
,
::
AnnotationKey
,
::
CloogleEntry
from
Data
.
Map
import
::
Map
from
Data
.
Maybe
import
::
Maybe
from
Cloogle
.
API
import
::
Request
,
::
Result
,
::
LocationResult
from
Cloogle
.
DB
import
::
CloogleDB
,
::
AnnotationKey
,
::
CloogleEntry
,
::
FunctionEntry
from
Cloogle
.
Search
.
Rank
import
::
RankSettings
/**
* Cloogle setting: whether to include language builtins if the Request has
...
...
@@ -29,10 +34,21 @@ DEFAULT_INCLUDE_APPS :== False
/**
* Search for a request in the type database
*/
search
::
!
Request
!*
CloogleDB
->
*([
Result
],
*
CloogleDB
)
search
::
!
RankSettings
!
Request
!*
CloogleDB
->
*([
Result
],
*
CloogleDB
)
search`
::
!
Request
!*
CloogleDB
->
*(!
Maybe
Type
,
!(
Map
String
[
TypeDef
])
,
![
TypeDef
]
,
![(!
CloogleEntry
,
!
Map
AnnotationKey
Int
)]
,
!*
CloogleDB
)
unifyInformation
::
!(
Maybe
Type
)
!(
Map
String
[
TypeDef
])
![
TypeDef
]
!
FunctionEntry
!*
CloogleDB
->
*(!
Maybe
Unifier
,
![
TypeDef
],
!
Maybe
[(!
String
,
![
LocationResult
])],
!*
CloogleDB
)
/**
* Search for a request, and also make suggestions for similar requests with
* better results.
*/
searchWithSuggestions
::
!
Request
!*
CloogleDB
->
*([
Result
],
[(
Request
,[
Result
])],
*
CloogleDB
)
searchWithSuggestions
::
!
RankSettings
!
Request
!*
CloogleDB
->
*([
Result
],
[(
Request
,[
Result
])],
*
CloogleDB
)
Cloogle/Search.icl
View file @
196fee32
...
...
@@ -30,6 +30,7 @@ import Clean.Doc
import
Cloogle
.
API
import
Cloogle
.
DB
import
Cloogle
.
Search
.
Rank
::
SearchStrategy
=
SSIdentity
...
...
@@ -53,8 +54,20 @@ searchStrategy (SSClassName n) db = filterDB (\ce->ce=:(ClassEntry _)) $ filterE
searchStrategy
(
SSUsing
f
ns
)
db
=
filterUsages
f
ns
db
searchStrategy
(
SSAnd
a
b
)
db
=
searchStrategy
b
$
searchStrategy
a
db
search
::
!
Request
!*
CloogleDB
->
*([
Result
],
*
CloogleDB
)
search
{
unify
,
name
,
className
,
typeName
,
using
,
modules
,
libraries
,
page
,
include_builtins
,
include_core
,
include_apps
}
cdb
search
::
!
RankSettings
!
Request
!*
CloogleDB
->
*([
Result
],
*
CloogleDB
)
search
rsets
req
cdb
#
(
mbType
,
allsyns
,
usedsyns
,
entries
,
cdb
)
=
search`
req
cdb
#
(
es
,
cdb
)
=
mapSt
(
makeResult
rsets
mbType
allsyns
usedsyns
)
entries
cdb
=
(
sort
$
catMaybes
es
,
cdb
)
search`
::
!
Request
!*
CloogleDB
->
*(!
Maybe
Type
,
!(
Map
String
[
TypeDef
])
,
![
TypeDef
]
,
![(!
CloogleEntry
,
!
Map
AnnotationKey
Int
)]
,
!*
CloogleDB
)
search`
{
unify
,
name
,
className
,
typeName
,
using
,
modules
,
libraries
,
page
,
include_builtins
,
include_core
,
include_apps
}
cdb
#
include_builtins
=
fromMaybe
DEFAULT_INCLUDE_BUILTINS
include_builtins
#
include_core
=
fromMaybe
DEFAULT_INCLUDE_CORE
include_core
#
include_apps
=
fromMaybe
DEFAULT_INCLUDE_APPS
include_apps
...
...
@@ -76,7 +89,7 @@ search {unify,name,className,typeName,using,modules,libraries,page,include_built
#
(
allsyns
,
cdb
)
=
allTypeSynonyms
cdb
#
(
alwaysUnique
,
cdb
)
=
alwaysUniquePredicate
cdb
#
mbPreppedType
=
prepare_unification
True
alwaysUnique
allsyns
<$>
(
unify
>>=
parseType
o
fromString
)
#
used
S
yn
onym
s
=
'
Foldable
'.
concat
(
fst
<$>
mbPreppedType
)
#
used
s
yns
=
'
Foldable
'.
concat
(
fst
<$>
mbPreppedType
)
#
mbType
=
snd
<$>
mbPreppedType
#
strat
=
addStrategy
(
SSUnify
<$>
mbType
)
strat
// Usage search
...
...
@@ -85,13 +98,70 @@ search {unify,name,className,typeName,using,modules,libraries,page,include_built
#
cdb
=
searchStrategy
strat
cdb
#
cdb
=
removeContainedEntries
cdb
#
(
es
,
cdb
)
=
getEntries
cdb
#
(
es
,
cdb
)
=
mapSt
(
makeResult
mbType
allsyns
usedSynonyms
)
es
cdb
=
(
sort
$
catMaybes
es
,
cdb
)
=
(
mbType
,
allsyns
,
usedsyns
,
es
,
cdb
)
unifyInformation
::
!(
Maybe
Type
)
!(
Map
String
[
TypeDef
])
![
TypeDef
]
!
FunctionEntry
!*
CloogleDB
->
*(!
Maybe
Unifier
,
![
TypeDef
],
!
Maybe
[(!
String
,
![
LocationResult
])],
!*
CloogleDB
)
unifyInformation
orgsearchtype
allsyns
usedsyns
fe
db
#
(
alwaysUnique
,
db
)
=
alwaysUniquePredicate
db
#
fe_type
=
prepare_unification
False
alwaysUnique
allsyns
<$>
fe
.
fe_type
#
usedsyns
=
case
fe_type
of
Nothing
->
usedsyns
;
Just
(
syns
,_)
->
syns
++
usedsyns
#
unif
=
fe_type
>>=
\(_,
type
)
->
finish_unification
usedsyns
<$>
(
orgsearchtype
>>=
unify
type
)
// Required Context
#
(
ownContext
,
db
)
=
ownContext
fe
db
#
(
required_context
,
db
)
=
fromMaybe
(
tuple
Nothing
)
(
liftA2
(
findContext
ownContext
)
fe
.
fe_type
unif
)
db
=
(
unif
,
usedsyns
,
required_context
,
db
)
where
ownContext
::
FunctionEntry
*
CloogleDB
->
*([
TypeRestriction
],
*
CloogleDB
)
ownContext
fe
db
|
isJust
fe
.
fe_generic_vars
=
([
Derivation
(
getName
fe
.
fe_loc
)
(
Var
v
)
\\
v
<-
fromJust
fe
.
fe_generic_vars
],
db
)
=
case
fe
.
fe_class
of
Nothing
->
([],
db
)
Just
ci
->
let
({
value
=
ClassEntry
ce
},
db`
)
=
getIndex
ci
db
in
([
Instance
(
getName
ce
.
ce_loc
)
(
map
Var
ce
.
ce_vars
)],
db`
)
findContext
::
[
TypeRestriction
]
Type
Unifier
*
CloogleDB
->
*(
Maybe
[(
String
,
[
LocationResult
])],
*
CloogleDB
)
findContext
trs
t
unif
db
#
trs
=
removeDup
(
concatMap
applyUnifToTR
(
getTC
t
++
trs
))
=
appFst
Just
$
mapSt
(\
tr
->
appFst
(
tuple
(
concat
$
print
False
tr
)
o
map
locResult
)
o
findLocations
tr
)
trs
db
where
getTC
::
Type
->
TypeContext
getTC
(
Func
_
_
tc
)
=
tc
getTC
(
Forall
_
_
tc
)
=
tc
getTC
_
=
[]
applyUnifToTR
::
TypeRestriction
->
[
TypeRestriction
]
applyUnifToTR
(
Instance
c
ts
)
=
maybeToList
$
Instance
c
<$>
mapM
uni
ts
applyUnifToTR
(
Derivation
g
t
)
|
any
isFunc
subts
=
[
Derivation
g
(
Arrow
Nothing
):
derivs
]
|
otherwise
=
derivs
where
subts
=
[
st
\\
ut
<-
maybeToList
(
uni
t
),
st
<-
subtypes
ut
]
derivs
=
[
Derivation
g
(
Type
st
[])
\\
Type
st
_
<-
subts
]
uni
::
(
Type
->
Maybe
Type
)
uni
=
fmap
norm
o
assignAll
(
map
fromUnifyingAssignment
unif
.
assignments
)
norm
::
(
Type
->
Type
)
norm
=
snd
o
resolve_synonyms
allsyns
findLocations
::
TypeRestriction
*
CloogleDB
->
*([
Location
],
*
CloogleDB
)
findLocations
(
Instance
c
ts
)
db
#
(
ies
,
db
)
=
getInstances
c
db
=
(
removeDup
$
flatten
[
ie
.
ie_locations
\\
ie
<-
ies
|
and
[
norm
t1
generalises
t2
\\
t1
<-
map
fst
ie
.
ie_types
&
t2
<-
ts
]],
db
)
findLocations
(
Derivation
g
t
)
db
#
(
des
,
db
)
=
getDerivations
g
db
=
(
removeDup
$
flatten
[
de
.
de_locations
\\
de
<-
des
|
norm
de
.
de_type
generalises
t
],
db
)
makeResult
::
(
Maybe
Type
)
(
Map
String
[
TypeDef
])
[
TypeDef
]
(
CloogleEntry
,
Map
AnnotationKey
Int
)
*
CloogleDB
->
*(
Maybe
Result
,
*
CloogleDB
)
makeResult
orgsearchtype
allsyns
usedsyns
(
entry
,
annots
)
db
makeResult
::
!
RankSettings
!
(
Maybe
Type
)
!
(
Map
String
[
TypeDef
])
!
[
TypeDef
]
!(!
CloogleEntry
,
!
Map
AnnotationKey
Int
)
!
*
CloogleDB
->
*(
!
Maybe
Result
,
!
*
CloogleDB
)
makeResult
rsets
orgsearchtype
allsyns
usedsyns
(
entry
,
annots
)
db
|
entry
=:
(
FunctionEntry
_)
#
(
FunctionEntry
fe
)
=
entry
// Parent class
...
...
@@ -100,24 +170,14 @@ makeResult orgsearchtype allsyns usedsyns (entry, annots) db
Just
i
->
case
getIndex
i
db
of
({
value
=
ClassEntry
ce
},
db
)
->
(
Just
{
cls_name
=
getName
ce
.
ce_loc
,
cls_vars
=
ce
.
ce_vars
},
db
)
// Unifier
#
(
alwaysUnique
,
db
)
=
alwaysUniquePredicate
db
#
unif
=
prepare_unification
False
alwaysUnique
allsyns
<$>
fe
.
fe_type
>>=
\(
syns
,
type
)
->
finish_unification
(
syns
++
usedsyns
)
<$>
(
orgsearchtype
>>=
unify
type
)
// Required Context
#
(
ownContext
,
db
)
=
ownContext
fe
db
#
(
required_context
,
db
)
=
fromMaybe
(
tuple
Nothing
)
(
liftA2
(
findContext
ownContext
)
fe
.
fe_type
unif
)
db
#
(
unif
,
usedsyns
,
required_context
,
db
)
=
unifyInformation
orgsearchtype
allsyns
usedsyns
fe
db
// Derivations
#
(
derivs
,
db
)
=
case
fe
.
fe_derivations
of
Nothing
->
(
Nothing
,
db
)
Just
ds
->
appFst
Just
$
getIndices
ds
db
=
(
Just
$
FunctionResult
(
{
general
&
distance
=
kindPenalty
fe
.
fe_kind
$
general
.
distance
+
sum
[
fromMaybe
0
$
contextPenalty
<$>
required_context
,
fromMaybe
0
$
'M'
.
get
UnifierSize
annots
,
length
usedsyns
]
&
distance
=
distance
rsets
entry
annots
(
Just
{
tri_used_synonyms
=
usedsyns
,
tri_required_context
=
required_context
})
,
documentation
=
docDescription
=<<
fe
.
fe_documentation
},
{
kind
=
fe
.
fe_kind
...
...
@@ -153,64 +213,6 @@ makeResult orgsearchtype allsyns usedsyns (entry, annots) db
where
toStr
(
var
,
type
)
=
(
var
,
concat
$
print
False
type
)
kindPenalty
::
FunctionKind
Int
->
Int
kindPenalty
k
d
=
toInt
$
penalty
*
toReal
d
where
penalty
=
case
k
of
RecordField
->
further
0.2
Constructor
->
further
0.1
_
->
1.0
further
s
=
if
(
d
<
0
)
(
1.0
-
s
)
(
1.0
+
s
)
contextPenalty
::
[(
String
,
[
LocationResult
])]
->
Int
contextPenalty
required_context
=
length
[
0
\\
(_,[])
<-
required_context
]
ownContext
::
FunctionEntry
*
CloogleDB
->
*([
TypeRestriction
],
*
CloogleDB
)
ownContext
fe
db
|
isJust
fe
.
fe_generic_vars
=
([
Derivation
(
getName
fe
.
fe_loc
)
(
Var
v
)
\\
v
<-
fromJust
fe
.
fe_generic_vars
],
db
)
=
case
fe
.
fe_class
of
Nothing
->
([],
db
)
Just
ci
->
let
({
value
=
ClassEntry
ce
},
db`
)
=
getIndex
ci
db
in
([
Instance
(
getName
ce
.
ce_loc
)
(
map
Var
ce
.
ce_vars
)],
db`
)
findContext
::
[
TypeRestriction
]
Type
Unifier
*
CloogleDB
->
*(
Maybe
[(
String
,
[
LocationResult
])],
*
CloogleDB
)
findContext
trs
t
unif
db
#
trs
=
removeDup
(
concatMap
applyUnifToTR
(
getTC
t
++
trs
))
=
appFst
Just
$
mapSt
(\
tr
->
appFst
(
tuple
(
concat
$
print
False
tr
)
o
map
locResult
)
o
findLocations
tr
)
trs
db
where
getTC
::
Type
->
TypeContext
getTC
(
Func
_
_
tc
)
=
tc
getTC
(
Forall
_
_
tc
)
=
tc
getTC
_
=
[]
applyUnifToTR
::
TypeRestriction
->
[
TypeRestriction
]
applyUnifToTR
(
Instance
c
ts
)
=
maybeToList
$
Instance
c
<$>
mapM
uni
ts
applyUnifToTR
(
Derivation
g
t
)
|
any
isFunc
subts
=
[
Derivation
g
(
Arrow
Nothing
):
derivs
]
|
otherwise
=
derivs
where
subts
=
[
st
\\
ut
<-
maybeToList
(
uni
t
),
st
<-
subtypes
ut
]
derivs
=
[
Derivation
g
(
Type
st
[])
\\
Type
st
_
<-
subts
]
uni
::
(
Type
->
Maybe
Type
)
uni
=
fmap
norm
o
assignAll
(
map
fromUnifyingAssignment
unif
.
assignments
)
norm
::
(
Type
->
Type
)
norm
=
snd
o
resolve_synonyms
allsyns
findLocations
::
TypeRestriction
*
CloogleDB
->
*([
Location
],
*
CloogleDB
)
findLocations
(
Instance
c
ts
)
db
#
(
ies
,
db
)
=
getInstances
c
db
=
(
removeDup
$
flatten
[
ie
.
ie_locations
\\
ie
<-
ies
|
and
[
norm
t1
generalises
t2
\\
t1
<-
map
fst
ie
.
ie_types
&
t2
<-
ts
]],
db
)
findLocations
(
Derivation
g
t
)
db
#
(
des
,
db
)
=
getDerivations
g
db
=
(
removeDup
$
flatten
[
de
.
de_locations
\\
de
<-
des
|
norm
de
.
de_type
generalises
t
],
db
)
|
entry
=:
(
TypeDefEntry
_)
#
(
TypeDefEntry
tde
)
=
entry
#
(
insts
,
db
)
=
getIndices
tde
.
tde_instances
db
...
...
@@ -291,7 +293,7 @@ where
,
dcl_line
=
getDclLine
=<<
mbLoc
,
icl_line
=
getIclLine
=<<
mbLoc
,
name
=
fromMaybe
""
(
getName
<$>
mbLoc
)
,
distance
=
distance
,
distance
=
distance
rsets
entry
annots
Nothing
,
builtin
=
case
mbLoc
of
Just
(
Builtin
_
_)
->
Just
True
_
->
Nothing
...
...
@@ -300,13 +302,10 @@ where
Just
(
Builtin
_
d
)
->
Just
d
_
->
Nothing
}
distance
=
fromMaybe
0
(
'M'
.
get
NGramDistance
annots
)
-
1000
*
fromMaybe
0
(
'M'
.
get
ExactResult
annots
)
searchWithSuggestions
::
!
Request
!*
CloogleDB
->
*([
Result
],
[(
Request
,[
Result
])],
*
CloogleDB
)
searchWithSuggestions
req
db
#
(
res
,
db
)
=
search
req
db
searchWithSuggestions
::
!
RankSettings
!
Request
!*
CloogleDB
->
*([
Result
],
[(
Request
,[
Result
])],
*
CloogleDB
)
searchWithSuggestions
rsets
req
db
#
(
res
,
db
)
=
search
rsets
req
db
#
(
suggs
,
db
)
=
suggestions
req
res
db
=
(
res
,
suggs
,
db
)
where
...
...
@@ -322,7 +321,7 @@ where
swap
db
=
case
orgtype
of
Just
(
Func
is
r
cc
)
|
length
is
<
3
->
appFst
(
filter
enough
)
$
mapSt
(\
r
->
appFst
(
tuple
r
)
o
search
r
o
resetDB
)
reqs
db
->
appFst
(
filter
enough
)
$
mapSt
(\
r
->
appFst
(
tuple
r
)
o
search
rsets
r
o
resetDB
)
reqs
db
with
reqs
=
[{
orgreq
&
unify
=
Just
$
concat
$
print
False
$
Func
is`
r
cc
}
\\
is`
<-
permutations
is
|
is`
<>
is
]
...
...
@@ -337,7 +336,7 @@ where
capitalize
db
=
case
t`
of
Just
t`
|
fromJust
orgtype
<>
t`
->
appFst
(\
res
->
[(
req
,
res
)])
$
search
req
$
resetDB
db
->
appFst
(\
res
->
[(
req
,
res
)])
$
search
rsets
req
$
resetDB
db
with
req
=
{
orgreq
&
unify
=
Just
$
concat
$
print
False
t`
}
_
->
([],
db
)
where
...
...
@@ -356,7 +355,7 @@ where
|
isJust
orgreq
.
unify
=
([],
db
)
// unification search can be slow
|
fromMaybe
DEFAULT_INCLUDE_APPS
orgreq
.
include_apps
==
DEFAULT_INCLUDE_APPS
#
req
=
{
orgreq
&
include_apps
=
Just
(
not
DEFAULT_INCLUDE_APPS
)}
#
(
res
,
db
)
=
search
req
$
resetDB
db
#
(
res
,
db
)
=
search
rsets
req
$
resetDB
db
|
isEmpty
res
=
([],
db
)
|
isEmpty
orgresults
=
([(
req
,
res
)],
db
)
#
orghddistance
=
(
fromJust
(
getBasicResult
(
hd
orgresults
))).
distance
...
...
Cloogle/Search/Rank.dcl
0 → 100644
View file @
196fee32
definition
module
Cloogle
.
Search
.
Rank
from
Clean
.
Types
import
::
TypeDef
from
Data
.
Map
import
::
Map
from
Data
.
Maybe
import
::
Maybe
from
Cloogle
.
API
import
::
Request
,
::
LocationResult
,
::
FunctionKind
from
Cloogle
.
DB
import
::
AnnotationKey
,
::
CloogleEntry
,
::
CloogleDB
::
TypeRankInfo
=
{
tri_required_context
::
!
Maybe
[(
String
,
[
LocationResult
])]
,
tri_used_synonyms
::
![
TypeDef
]
}
/**
* A rank is computed as the weighted sum of various metrics. The coefficients
* are given by this record.
*/
::
RankSettings
=
{
rs_ngram_distance
::
!
Real
//* n-gram distance
,
rs_exact_result
::
!
Real
//* results with an exact match
,
rs_record_field
::
!
Real
//* record fields
,
rs_constructor
::
!
Real
//* constructors
,
rs_unifier_size
::
!
Real
//* large unifiers
,
rs_used_synonyms
::
!
Real
//* the number of synonyms required
,
rs_resolved_context
::
!
Real
//* class contexts with known instances
,
rs_unresolved_context
::
!
Real
//* class contexts without known instances
}
/**
* This record is the same as {{`RankSettings`}}, but the members are
* interpreted as the values rather than the weights.
*/
::
RankInformation
:==
RankSettings
distance
::
!
RankSettings
!
CloogleEntry
!(
Map
AnnotationKey
Int
)
!(
Maybe
TypeRankInfo
)
->
Int
symbolicDistance
::
!
CloogleEntry
!(
Map
AnnotationKey
Int
)
!(
Maybe
TypeRankInfo
)
->
RankInformation
::
RankConstraint
=
LT
!
UniqueResultIdentifier
!
UniqueResultIdentifier
//* arg1 should have lower distance than arg2
/**
* @representation module name and name of element
*/
::
UniqueResultIdentifier
:==
(!
String
,
!
String
)
/**
* Generate Z3 constraints based on a set of constraints on the order of
* results for queries.
*/
rankConstraints
::
![(
Request
,
RankConstraint
)]
!*
CloogleDB
->
*([
String
],
*
CloogleDB
)
Cloogle/Search/Rank.icl
0 → 100644
View file @
196fee32
implementation
module
Cloogle
.
Search
.
Rank
import
StdBool
import
StdInt
import
StdList
import
StdMisc
import
StdReal
import
StdString
import
Clean
.
Types
from
Data
.
Func
import
$
import
Data
.
Functor
from
Data
.
List
import
foldr1
import
qualified
Data
.
Map
as
M
import
Data
.
Maybe
import
Data
.
Tuple
import
Text
import
Cloogle
.
API
import
Cloogle
.
DB
import
Cloogle
.
Search
distance
::
!
RankSettings
!
CloogleEntry
!(
Map
AnnotationKey
Int
)
!(
Maybe
TypeRankInfo
)
->
Int
distance
settings
entry
annots
tri
=
let
info
=
symbolicDistance
entry
annots
tri
in
toInt
$
settings
.
rs_ngram_distance
*
info
.
rs_ngram_distance
+
settings
.
rs_exact_result
*
info
.
rs_exact_result
+
settings
.
rs_record_field
*
info
.
rs_record_field
+
settings
.
rs_constructor
*
info
.
rs_constructor
+
settings
.
rs_unifier_size
*
info
.
rs_unifier_size
+
settings
.
rs_used_synonyms
*
info
.
rs_used_synonyms
+
settings
.
rs_resolved_context
*
info
.
rs_resolved_context
+
settings
.
rs_unresolved_context
*
info
.
rs_unresolved_context
symbolicDistance
::
!
CloogleEntry
!(
Map
AnnotationKey
Int
)
!(
Maybe
TypeRankInfo
)
->
RankInformation
symbolicDistance
entry
annots
tri
=
{
rs_ngram_distance
=
fromMaybe
0.0
$
toReal
<$>
'M'
.
get
NGramDistance
annots
,
rs_exact_result
=
fromMaybe
0.0
$
toReal
<$>
'M'
.
get
ExactResult
annots
,
rs_record_field
=
case
entry
of
FunctionEntry
{
fe_kind
=
k
=:
RecordField
}
->
1.0
;
_
->
0.0
,
rs_constructor
=
case
entry
of
FunctionEntry
{
fe_kind
=
k
=:
Constructor
}
->
1.0
;
_
->
0.0
,
rs_unifier_size
=
fromMaybe
0.0
$
toReal
<$>
'M'
.
get
UnifierSize
annots
,
rs_used_synonyms
=
case
tri
of
Nothing
->
0.0
;
Just
tri
->
toReal
$
length
tri
.
tri_used_synonyms
,
rs_resolved_context
=
resolved_context
,
rs_unresolved_context
=
unresolved_context
}
where
(
resolved_context
,
unresolved_context
)
=
case
tri
of
Just
{
tri_required_context
=
Just
rc
}
->
let
(
res
,
unres
)
=
context_sizes
0
0
rc
in
(
toReal
res
,
toReal
unres
)
->
(
0.0
,
0.0
)
where
context_sizes
::
!
Int
!
Int
![(
String
,[
LocationResult
])]
->
(!
Int
,
!
Int
)
context_sizes
res
unres
[(_,
locs
):
rest
]
|
locs
=:[]
=
context_sizes
res
(
unres
+1
)
rest
|
otherwise
=
context_sizes
(
res
+1
)
unres
rest
context_sizes
res
unres
[]
=
(
res
,
unres
)
match
::
!
UniqueResultIdentifier
!
CloogleEntry
->
Bool
match
(
mod
,
name
)
ce
=
case
getLocation
ce
of
Just
(
Location
_
cemod
_
_
_
cename
)
->
mod
==
cemod
&&
name
==
cename
Just
(
Builtin
cename
_)
->
mod
==
"_builtin"
&&
name
==
cename
_
->
abort
"error in match of UniqueResultIdentifier
\n
"
rankConstraints
::
![(
Request
,
RankConstraint
)]
!*
CloogleDB
->
*([
String
],
*
CloogleDB
)
rankConstraints
constraints
db
#
(
constraints
,
db
)
=
findConstraints
constraints
db
=
(
default
++
constraints
,
db
)
where
default
=
[
"(declare-const rs_ngram_distance Real)"
,
"(declare-const rs_exact_result Real)"
,
"(declare-const rs_record_field Real)"
,
"(declare-const rs_constructor Real)"
,
"(declare-const rs_unifier_size Real)"
,
"(declare-const rs_used_synonyms Real)"
,
"(declare-const rs_resolved_context Real)"
,
"(declare-const rs_unresolved_context Real)"
]
findConstraints
::
![(
Request
,
RankConstraint
)]
!*
CloogleDB
->
*([
String
],
*
CloogleDB
)
findConstraints
[(
req
,
LT
urid1
urid2
):
rest
]
cdb
#
(
orgsearchtype
,
allsyns
,
usedsyns
,
entries
,
cdb
)
=
search`
req
cdb
#
(
e1
,
annots1
)
=
case
filter
(\(
e
,_)
->
match
urid1
e
)
entries
of
[
e1
:[]]
->
e1
[]
->
abort
"no match for URID 1
\n
"
_
->
abort
"too many matches for URID 1
\n
"
#
(
e2
,
annots2
)
=
case
filter
(\(
e
,_)
->
match
urid2
e
)
entries
of
[
e2
:[]]
->
e2
[]
->
abort
"no match for URID 2
\n
"
_
->
abort
"too many matches for URID 2
\n
"
#
(
ri1
,
cdb
)
=
case
e1
of
FunctionEntry
fe
#
(
unif
,
usedsyns
,
required_context
,
cdb
)
=
unifyInformation
orgsearchtype
allsyns
usedsyns
fe
cdb
->
(
symbolicDistance
e1
annots1
(
Just
{
tri_used_synonyms
=
usedsyns
,
tri_required_context
=
required_context
}),
cdb
)
_
->
(
symbolicDistance
e1
annots1
Nothing
,
cdb
)
#
(
ri2
,
cdb
)
=
case
e2
of
FunctionEntry
fe
#
(
unif
,
usedsyns
,
required_context
,
cdb
)
=
unifyInformation
orgsearchtype
allsyns
usedsyns
fe
cdb
->
(
symbolicDistance
e2
annots2
(
Just
{
tri_used_synonyms
=
usedsyns
,
tri_required_context
=
required_context
}),
cdb
)
_
->
(
symbolicDistance
e2
annots2
Nothing
,
cdb
)
#
this
=
"(assert (< ("
+++
formula
ri1
+++
") ("
+++
formula
ri2
+++
")))"
#
cdb
=
resetDB
cdb
#
(
rest
,
cdb
)
=
findConstraints
rest
cdb
=
([
this
:
rest
],
cdb
)
where
formula
::
!
RankInformation
->
String
formula
ri
=
sum
[
"* rs_ngram_distance "
<+
ri
.
rs_ngram_distance
,
"* rs_exact_result "
<+
ri
.
rs_exact_result
,
"* rs_record_field "
<+
ri
.
rs_record_field
,
"* rs_constructor "
<+
ri
.
rs_constructor
,
"* rs_unifier_size "
<+
ri
.
rs_unifier_size
,
"* rs_used_synonyms "
<+
ri
.
rs_used_synonyms
,
"* rs_resolved_context "
<+
ri
.
rs_resolved_context
,
"* rs_unresolved_context "
<+
ri
.
rs_unresolved_context
]
where
sum
::
[
String
]
->
String
sum
[
t
]
=
t
sum
[
t
:
ts
]
#
s
=
sum
ts
=
"+ ("
+++
t
+++
") ("
+++
s
+++
")"
findConstraints
[]
cdb
=
([],
cdb
)
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