DB.icl 18.2 KB
Newer Older
1
implementation module Cloogle.DB
Camil Staps's avatar
Camil Staps committed
2 3 4 5 6

// Standard libraries
import StdArray
import StdBool
import StdFile
7
from StdFunc import id, o, const
Camil Staps's avatar
Camil Staps committed
8 9 10 11 12 13 14 15 16
import StdList
import StdMisc
import StdOrdList
import StdOverloaded
import StdString
import StdTuple

import Control.Applicative
import Control.Monad
17
import Data.Bifunctor
Camil Staps's avatar
Camil Staps committed
18
import Data.Error
19
from Data.Foldable import class Foldable(foldr1)
Camil Staps's avatar
Camil Staps committed
20
from Data.Func import $, on, `on`, mapSt
Camil Staps's avatar
Camil Staps committed
21
import Data.Functor
Camil Staps's avatar
Camil Staps committed
22
import Data.GenLexOrd
23
import Data.Graphviz
24
from Data.List import concatMap, groupBy, intercalate, intersect, partition,
25
	tails, instance Functor [], instance Foldable []
26
from Data.Map import :: Map(..), elems, filterWithKey, foldrNoKey,
27 28
	foldrWithKey, fromList, get, mapSize, alter, mapWithKey, newMap, put,
	toAscList, toList, instance Functor (Map k)
Camil Staps's avatar
Camil Staps committed
29
import Data.Maybe
30 31
import Data.NGramIndex
import qualified Data.NGramIndex as NGrams
Camil Staps's avatar
Camil Staps committed
32
import Data.Tuple
33 34 35 36
from Database.Native import :: NativeDB, :: Index, :: Entry{..},
	:: SearchMode(..), instance == Index, instance < Index
import qualified Database.Native as DB
import Database.Native.JSON
Camil Staps's avatar
Camil Staps committed
37
import System.File
Camil Staps's avatar
Camil Staps committed
38
import System.FilePath
Camil Staps's avatar
Camil Staps committed
39
from Text import class Text(concat), instance Text String
40
import Text.GenJSON
Camil Staps's avatar
Camil Staps committed
41

42 43
import Regex

44 45 46
import Clean.Types
import Clean.Types.Tree
import Clean.Types.Util
Camil Staps's avatar
Camil Staps committed
47

48
import Clean.Doc
Camil Staps's avatar
Camil Staps committed
49

50
import Cloogle.API
Camil Staps's avatar
Camil Staps committed
51

52 53 54
derive JSONEncode ClassDoc, ClassEntry, ClassMemberDoc, CloogleEntry,
	Constructor, ConstructorDoc, DeriveEntry, FunctionDoc, FunctionEntry,
	InstanceEntry, Location, ModuleDoc, ModuleEntry, Priority, RecordField,
Camil Staps's avatar
Camil Staps committed
55
	SyntaxEntry, Type, TypeDef, TypeDefEntry, TypeDefRhs, TypeDoc, ParamDoc,
56
	TypeRestriction, ABCInstructionEntry, Property, PropertyVarInstantiation,
57
	MultiLineString, NGramIndex, PropertyTestGenerator, Regex, GroupId
58 59 60
derive JSONDecode ClassDoc, ClassEntry, ClassMemberDoc, CloogleEntry,
	Constructor, ConstructorDoc, DeriveEntry, FunctionDoc, FunctionEntry,
	InstanceEntry, Location, ModuleDoc, ModuleEntry, Priority, RecordField,
Camil Staps's avatar
Camil Staps committed
61
	SyntaxEntry, Type, TypeDef, TypeDefEntry, TypeDefRhs, TypeDoc, ParamDoc,
62
	TypeRestriction, ABCInstructionEntry, Property, PropertyVarInstantiation,
63
	MultiLineString, NGramIndex, PropertyTestGenerator, Regex, GroupId
Camil Staps's avatar
Camil Staps committed
64 65 66 67 68 69 70

printersperse :: Bool a [b] -> [String] | print a & print b
printersperse ia a bs = intercalate (print False a) (map (print ia) bs)

(--) infixr 5 :: a b -> [String] | print a & print b
(--) a b = print False a ++ print False b

71 72 73
instance zero Location where zero = NoLocation
derive gLexOrd Location, Maybe, CleanLangReportLocation
instance < Location where < a b = (a =?= b) === LT
74 75 76 77 78 79 80
instance == Location
where
	== (Location a b c d e f) (Location p q r s t u)
		= and [a==p, b==q, c==r, d==s, e==t, f==u]
	== (Builtin a _) (Builtin b _) = a == b
	== NoLocation NoLocation = True
	== _ _ = False
Camil Staps's avatar
Camil Staps committed
81 82 83

instance zero FunctionEntry
where
84 85 86 87 88 89 90 91
	zero =
		{ fe_loc            = zero
		, fe_kind           = Function
		, fe_type           = Nothing
		, fe_priority       = Nothing
		, fe_generic_vars   = Nothing
		, fe_representation = Nothing
		, fe_documentation  = Nothing
92
		, fe_typedef        = Nothing
93
		, fe_class          = Nothing
94
		, fe_derivations    = Nothing
95
		, fe_usages         = []
96
		}
Camil Staps's avatar
Camil Staps committed
97 98

instance zero ModuleEntry
99 100 101 102 103 104
where
	zero =
		{ me_loc=zero
		, me_is_core=False
		, me_is_app=False
		, me_documentation=Nothing
105
		, me_usages=[]
106
		}
Camil Staps's avatar
Camil Staps committed
107

Camil Staps's avatar
Camil Staps committed
108
instance print (!Name, !FunctionEntry)
Camil Staps's avatar
Camil Staps committed
109 110 111 112 113 114 115 116 117
where
	print b (f, fe)
		= gen -- fname -- " " -- prio -- vars -- if (isJust fe.fe_type) (":: " -- fe.fe_type) []
	where
		prio = case fe.fe_priority of
			Nothing -> []
			Just p -> print b p -- " "
		vars = case fe.fe_generic_vars of
			Nothing -> []
118
			Just vs -> printersperse b " " vs -- " "
Camil Staps's avatar
Camil Staps committed
119 120 121 122 123 124
		gen = if (isJust fe.fe_generic_vars) "generic " ""
		fname
		| isJust fe.fe_priority     = concat ("(" -- f -- ")")
		| fe.fe_kind == RecordField = "." +++ f
		| otherwise                 = f

Camil Staps's avatar
Camil Staps committed
125 126 127
location :: !Library !String !FilePath !LineNr !LineNr !Name -> Location
location lib mod fp dcl icl name = Location lib mod fp dcl icl name

128 129 130 131
instance getLocation FunctionEntry where getLocation fe  = Just fe.fe_loc
instance getLocation TypeDefEntry  where getLocation tde = Just tde.tde_loc
instance getLocation ModuleEntry   where getLocation me  = Just me.me_loc
instance getLocation ClassEntry    where getLocation ce  = Just ce.ce_loc
132
instance getLocation SyntaxEntry   where getLocation se  = Just $ Builtin se.SyntaxEntry.syntax_title se.syntax_doc_locations
133 134 135 136 137 138
instance getLocation CloogleEntry
where
	getLocation (FunctionEntry e) = getLocation e
	getLocation (TypeDefEntry e)  = getLocation e
	getLocation (ModuleEntry e) = getLocation e
	getLocation (ClassEntry e) = getLocation e
139
	getLocation (SyntaxEntry e) = getLocation e
140 141
	getLocation _ = Nothing

Camil Staps's avatar
Camil Staps committed
142
getLibrary :: !Location -> Maybe Name
143 144 145
getLibrary (Location lib  _ _ _ _ _) = Just lib
getLibrary _ = Nothing

Camil Staps's avatar
Camil Staps committed
146
getModule :: !Location -> Maybe Name
147 148 149
getModule (Location _ mod  _ _ _ _) = Just mod
getModule _ = Nothing

150 151 152 153
setModule :: !Name !Location -> Location
setModule m (Location lib _ fname dcl icl n) = Location lib m fname dcl icl n
setModule _ l                                = l

Camil Staps's avatar
Camil Staps committed
154
getFilename :: !Location -> Maybe String
155 156 157
getFilename (Location _ _ fn  _ _ _) = Just fn
getFilename _ = Nothing

Camil Staps's avatar
Camil Staps committed
158
getDclLine :: !Location -> Maybe Int
159 160 161
getDclLine (Location _ _ _ dcl  _ _) = dcl
getDclLine _ = Nothing

Camil Staps's avatar
Camil Staps committed
162
getIclLine :: !Location -> Maybe Int
163 164 165
getIclLine (Location _ _ _ _ icl  _) = icl
getIclLine _ = Nothing

Camil Staps's avatar
Camil Staps committed
166
getName :: !Location -> Name
Camil Staps's avatar
Camil Staps committed
167 168
getName (Location _ _ _ _ _ name) = name
getName (Builtin name _)          = name
Camil Staps's avatar
Camil Staps committed
169

Camil Staps's avatar
Camil Staps committed
170
setName :: !Name !Location -> Location
Camil Staps's avatar
Camil Staps committed
171 172
setName n (Location lib mod fname dcl icl _) = Location lib mod fname dcl icl n
setName n (Builtin _ doc)                    = Builtin n doc
Camil Staps's avatar
Camil Staps committed
173

Camil Staps's avatar
Camil Staps committed
174
isBuiltin :: !Location -> Bool
175 176
isBuiltin (Builtin _ _) = True
isBuiltin _             = False
Camil Staps's avatar
Camil Staps committed
177

Camil Staps's avatar
Camil Staps committed
178
toTypeDefEntry :: !Location !TypeDef !(Maybe TypeDoc) -> TypeDefEntry
179 180 181 182 183
toTypeDefEntry loc td doc =
	{ tde_loc=loc
	, tde_typedef=td
	, tde_doc=doc
	, tde_instances=[]
184
	, tde_derivations=[]
185
	, tde_usages=[]
186
	}
Camil Staps's avatar
Camil Staps committed
187

Camil Staps's avatar
Camil Staps committed
188
getTypeDef :: !TypeDefEntry -> TypeDef
Camil Staps's avatar
Camil Staps committed
189 190
getTypeDef {tde_typedef} = tde_typedef

Camil Staps's avatar
Camil Staps committed
191
getTypeDefDoc :: !TypeDefEntry -> Maybe TypeDoc
Camil Staps's avatar
Camil Staps committed
192 193
getTypeDefDoc {tde_doc} = tde_doc

Camil Staps's avatar
Camil Staps committed
194
mergeTypeDefEntries :: !TypeDefEntry !TypeDefEntry -> TypeDefEntry
195 196 197 198 199
mergeTypeDefEntries a=:{tde_typedef={td_rhs=TDRAbstract Nothing}} b = case b.tde_typedef.td_rhs of
	TDRAbstract _ -> a
	rhs           -> {a & tde_typedef.td_rhs=TDRAbstract (Just rhs)}
mergeTypeDefEntries a b = b

Camil Staps's avatar
Camil Staps committed
200
toClass :: !Location ![String] !Bool !TypeContext !(Maybe ClassDoc) -> ClassEntry
Camil Staps's avatar
Camil Staps committed
201 202 203 204 205 206 207 208 209 210 211
toClass loc vs meta cc doc =
	{ ce_loc           = loc
	, ce_vars          = vs
	, ce_is_meta       = meta
	, ce_context       = cc
	, ce_documentation = doc
	, ce_members       = []
	, ce_instances     = []
	, ce_derivations   = []
	, ce_usages        = []
	}
Camil Staps's avatar
Camil Staps committed
212

Camil Staps's avatar
Camil Staps committed
213
classContext :: !ClassEntry -> [TypeRestriction]
214 215
classContext ce = ce.ce_context

Camil Staps's avatar
Camil Staps committed
216
saveDB :: !*CloogleDB !*File -> *(!*CloogleDB, !*File)
217
saveDB wrapper=:{db,name_ngrams,name_map,types,core,apps,builtins,syntax,
Camil Staps's avatar
Camil Staps committed
218
	abc_instrs,library_map,module_map,derive_map,instance_map,always_unique} f
219 220
# (db,f) = 'DB'.saveDB db f
# f = write name_ngrams f
221
# f = write name_map f
Camil Staps's avatar
Camil Staps committed
222
# f = write types f
Camil Staps's avatar
Camil Staps committed
223 224
# f = write core f
# f = write apps f
Camil Staps's avatar
Camil Staps committed
225
# f = write builtins f
Camil Staps's avatar
Camil Staps committed
226
# f = write syntax f
Camil Staps's avatar
Camil Staps committed
227
# f = write abc_instrs f
228 229
# f = write library_map f
# f = write module_map f
Camil Staps's avatar
Camil Staps committed
230 231
# f = write derive_map f
# f = write instance_map f
232
# f = write always_unique f
233
= ({wrapper & db=db}, f)
Camil Staps's avatar
Camil Staps committed
234
where
235 236 237 238 239 240 241
	write :: a *File -> *File | JSONEncode{|*|} a
	write x f = f <<< toString (toJSON x) <<< '\n'

openDB :: !*File -> *(!Maybe *CloogleDB, !*File)
openDB f
# ((ok,db),f) = appFst isJustU $ 'DB'.openDB f
| not ok = (Nothing, f)
Camil Staps's avatar
Camil Staps committed
242
# (name_ngrams,f) = read f
243
# (name_map,f) = read f
Camil Staps's avatar
Camil Staps committed
244 245 246 247 248
# (types,f) = read f
# (core,f) = read f
# (apps,f) = read f
# (builtins,f) = read f
# (syntax,f) = read f
Camil Staps's avatar
Camil Staps committed
249
# (abc_instrs,f) = read f
Camil Staps's avatar
Camil Staps committed
250 251 252 253
# (library_map,f) = read f
# (module_map,f) = read f
# (derive_map,f) = read f
# (instance_map,f) = read f
254
# (always_unique,f) = read f
Camil Staps's avatar
Camil Staps committed
255 256
= (
	name_ngrams >>= \name_ngrams ->
257
	name_map >>= \name_map ->
Camil Staps's avatar
Camil Staps committed
258 259 260 261 262
	types >>= \types ->
	core >>= \core ->
	apps >>= \apps ->
	builtins >>= \builtins ->
	syntax >>= \syntax ->
Camil Staps's avatar
Camil Staps committed
263
	abc_instrs >>= \abc_instrs ->
Camil Staps's avatar
Camil Staps committed
264 265 266
	library_map >>= \library_map ->
	module_map >>= \module_map ->
	derive_map >>= \derive_map ->
267 268
	instance_map >>= \instance_map ->
	always_unique >>= \always_unique -> Just
269
	{ db=fromJust db
Camil Staps's avatar
Camil Staps committed
270
	, name_ngrams=name_ngrams
271
	, name_map=name_map
Camil Staps's avatar
Camil Staps committed
272 273 274 275 276
	, types=types
	, core=core
	, apps=apps
	, builtins=builtins
	, syntax=syntax
Camil Staps's avatar
Camil Staps committed
277
	, abc_instrs=abc_instrs
Camil Staps's avatar
Camil Staps committed
278 279 280 281
	, library_map=library_map
	, module_map=module_map
	, derive_map=derive_map
	, instance_map=instance_map
282
	, always_unique=always_unique
283
	}, f)
284
where
285 286 287 288 289 290 291
	read :: *File -> *(Maybe a, *File) | JSONDecode{|*|} a
	read f
	# (end,f) = fend f
	| end = (Nothing, f)
	# (line,f) = freadline f
	= (fromJSON (fromString line), f)

Camil Staps's avatar
Camil Staps committed
292 293 294
	(>>=) Nothing  _ = Nothing // Overridden to deal with uniqueness
	(>>=) (Just x) f = f x

Camil Staps's avatar
Camil Staps committed
295 296 297
resetDB :: !*CloogleDB -> *CloogleDB
resetDB wrap=:{db} = {wrap & db='DB'.resetDB db}

Camil Staps's avatar
Camil Staps committed
298 299 300 301 302 303 304
dbStats :: !*CloogleDB -> *(CloogleDBStats, *CloogleDB)
dbStats wrap=:{db,types}
# (es,db) = 'DB'.allEntries db
# stats = foldr count zero es
= (stats, {wrap & db=db})
where
	count :: CloogleEntry CloogleDBStats -> CloogleDBStats
Camil Staps's avatar
Camil Staps committed
305 306 307 308 309 310 311 312
	count (ModuleEntry _)         st = {st & n_modules=st.n_modules+1}
	count (FunctionEntry _)       st = {st & n_functions=st.n_functions+1}
	count (ClassEntry _)          st = {st & n_classes=st.n_classes+1}
	count (TypeDefEntry _)        st = {st & n_type_definitions=st.n_type_definitions+1}
	count (InstanceEntry _)       st = {st & n_instances=st.n_instances+1}
	count (DeriveEntry _)         st = {st & n_derivations=st.n_derivations+1}
	count (SyntaxEntry _)         st = {st & n_syntax_constructs=st.n_syntax_constructs+1}
	count (ABCInstructionEntry _) st = {st & n_abc_instructions=st.n_abc_instructions+1}
Camil Staps's avatar
Camil Staps committed
313 314 315 316 317

	zero :: CloogleDBStats
	zero =
		{ n_modules             = 0
		, n_functions           = 0
Camil Staps's avatar
Camil Staps committed
318 319
		, n_functions_with_type = typeTreeSize types
		, n_unique_types        = typeTreeNodes types
Camil Staps's avatar
Camil Staps committed
320 321 322 323 324 325
		, type_tree_depth       = typeTreeDepth types
		, n_type_definitions    = 0
		, n_classes             = 0
		, n_instances           = 0
		, n_derivations         = 0
		, n_syntax_constructs   = 0
Camil Staps's avatar
Camil Staps committed
326
		, n_abc_instructions    = 0
Camil Staps's avatar
Camil Staps committed
327 328
		}

Camil Staps's avatar
Camil Staps committed
329 330 331 332 333
writeTypeTree :: !*CloogleDB !*File -> *(*CloogleDB, *File)
writeTypeTree db=:{types} f
# f = f <<< concat (printDigraph (typeTreeToGraphviz types))
= (db, f)

334
getIndex :: !Index !*CloogleDB -> *(Entry CloogleEntry Annotation, *CloogleDB)
335 336 337 338
getIndex idx wrap=:{db}
# (e,db) = 'DB'.getIndex idx db
= (e, {wrap & db=db})

339
getIndices :: ![Index] !*CloogleDB -> *([Entry CloogleEntry Annotation], *CloogleDB)
Camil Staps's avatar
Camil Staps committed
340 341 342 343
getIndices idxs wrap=:{db}
# (es,db) = 'DB'.getIndices idxs db
= (es, {wrap & db=db})

344
filterDB :: (CloogleEntry -> Bool) !*CloogleDB -> *CloogleDB
Camil Staps's avatar
Camil Staps committed
345
filterDB f db = {db & db = 'DB'.search Intersect (\v -> (f v, [])) db.db}
346

Camil Staps's avatar
Camil Staps committed
347 348 349 350 351 352 353 354 355 356
excludeCore :: !*CloogleDB -> *CloogleDB
excludeCore wrap=:{db,core}
# db = 'DB'.unsearchIndices core db
= {wrap & db=db}

excludeApps :: !*CloogleDB -> *CloogleDB
excludeApps wrap=:{db,apps}
# db = 'DB'.unsearchIndices apps db
= {wrap & db=db}

Camil Staps's avatar
Camil Staps committed
357 358 359 360 361 362 363 364 365 366
excludeBuiltins :: !*CloogleDB -> *CloogleDB
excludeBuiltins wrap=:{db,builtins}
# db = 'DB'.unsearchIndices builtins db
= {wrap & db=db}

includeBuiltins :: !*CloogleDB -> *CloogleDB
includeBuiltins wrap=:{db,builtins}
# db = 'DB'.searchIndices AddExcluded (map (flip tuple []) builtins) db
= {wrap & db=db}

367 368
filterLibraries :: ![Name] !*CloogleDB -> *CloogleDB
filterLibraries ss wrap=:{db,library_map}
Camil Staps's avatar
Camil Staps committed
369
# db = 'DB'.searchIndices Intersect (map (flip tuple []) idxs) db
370 371 372 373 374 375
= {wrap & db=db}
where
	idxs = foldr merge [] $ catMaybes $ map (flip get library_map) ss

filterModules :: ![Name] !*CloogleDB -> *CloogleDB
filterModules ss wrap=:{db,module_map}
Camil Staps's avatar
Camil Staps committed
376
# db = 'DB'.searchIndices Intersect (map (flip tuple []) idxs) db
377 378 379 380
= {wrap & db=db}
where
	idxs = foldr merge [] $ catMaybes $ map (flip get module_map) ss

381
filterName :: !String !*CloogleDB -> *CloogleDB
Camil Staps's avatar
Camil Staps committed
382
filterName s wrap=:{db,name_ngrams,syntax,abc_instrs}
383
# (indices,db) = mapSt (uncurry getIndexWithDistance) ('NGrams'.search s name_ngrams) db
Camil Staps's avatar
Camil Staps committed
384
# db = 'DB'.searchIndices Intersect indices db
Camil Staps's avatar
Camil Staps committed
385
# db = 'DB'.searchWithIndices syntaxSearch syntax db
Camil Staps's avatar
Camil Staps committed
386
# db = 'DB'.searchWithIndices abcSearch abc_instrs db
387
= {wrap & db=db}
Camil Staps's avatar
Camil Staps committed
388
where
389 390
	getIndexWithDistance :: !Index !Int !*(NativeDB CloogleEntry Annotation)
		-> *(!(!Index, ![Annotation]), !*NativeDB CloogleEntry Annotation)
391 392 393
	getIndexWithDistance idx n db
	# (e,db) = 'DB'.getIndex idx db
	# name = getName $ fromJust $ getLocation e.value
394 395 396 397 398 399
	# rn = toReal n
	# annots =
		[ MatchingNGramsQuery  (rn / qsize)
		, MatchingNGramsResult (rn / toReal (length $ 'NGrams'.ngrams NGRAMS_CI NGRAMS_N name))
		]
	= ((idx, annots), db)
Camil Staps's avatar
Camil Staps committed
400

401
	cs = [c \\ c <-: s]
402
	qsize = toReal $ length $ 'NGrams'.ngrams NGRAMS_CI NGRAMS_N s
403

Camil Staps's avatar
Camil Staps committed
404
	syntaxSearch :: CloogleEntry -> (Bool, [a])
405
	syntaxSearch (SyntaxEntry se) = (any (not o isEmpty o flip match cs) se.syntax_patterns, [])
Camil Staps's avatar
Camil Staps committed
406 407
	syntaxSearch _ = (False, [])

Camil Staps's avatar
Camil Staps committed
408 409 410 411
	abcSearch :: CloogleEntry -> (Bool, [a])
	abcSearch (ABCInstructionEntry ie) = (ie.aie_instruction == s, [])
	abcSearch _ = (False, [])

412 413
filterExactName :: !String !*CloogleDB -> *CloogleDB
filterExactName n wrap=:{db,name_map}
414
# db = 'DB'.searchIndices Intersect [(i,[ExactResult]) \\ i <- idxs] db
415 416 417 418
= {wrap & db=db}
where
	idxs = fromMaybe [] $ get n name_map

Camil Staps's avatar
Camil Staps committed
419 420
filterUnifying :: !Type !*CloogleDB -> *CloogleDB
filterUnifying t wrap=:{db,types}
Camil Staps's avatar
Camil Staps committed
421
# db = 'DB'.searchIndices Intersect idxs db
Camil Staps's avatar
Camil Staps committed
422 423
= {wrap & db=db}
where
424
	idxs = sortBy ((<) `on` fst) [(idx,[Unifier u]) \\ (t,u,idxs) <- findUnifying t types, idx <- idxs]
425

426 427
filterUsages :: !(*CloogleDB -> *CloogleDB) ![String] !*CloogleDB -> *CloogleDB
filterUsages filter names wrap=:{name_map}
Camil Staps's avatar
Camil Staps committed
428 429
// For each name, the corresponding entries
# idxss = map (fromMaybe [] o flip get name_map) names
430
# nameidxs = [(i,[ExactResult]) \\ i <- sort [i \\ is <- idxss, i <- is]]
431 432
# wrap=:{db} = filter wrap
# db = 'DB'.searchIndices Intersect nameidxs db
Camil Staps's avatar
Camil Staps committed
433 434
// For all lists of entries, the corresponding usages
# (entriess,db) = mapSt 'DB'.getIndices idxss db
435 436
# wrap & db = db
# wrap=:{db} = filter $ resetDB wrap
437
# usagess = map (foldr mergeUnion [] o map \e -> getUsages e.value) entriess
Camil Staps's avatar
Camil Staps committed
438
// AND all usages together
439 440 441
# usages = case usagess of
	[] -> []
	us -> foldr1 mergeIntersect us
442 443 444 445 446
# (es,db) = 'DB'.getIndices usages db
# usages = [(case e of
	FunctionEntry {fe_typedef=Just i} -> i
	FunctionEntry {fe_class=Just i}   -> i
	_                                 -> u) \\ u <- usages & {value=e} <- es]
447
# db = 'DB'.searchIndices Intersect (mergeUnionWithAnnots nameidxs [(u,[]) \\ u <- usages]) db
448 449
= {wrap & db=db}
where
Camil Staps's avatar
Camil Staps committed
450 451 452
	getUsages :: !CloogleEntry -> [Index]
	getUsages (TypeDefEntry tde) = tde.tde_usages
	getUsages (ClassEntry ce)    = ce.ce_usages
453
	getUsages (ModuleEntry me)   = me.me_usages
454
	getUsages (FunctionEntry fe) = fe.fe_usages
Camil Staps's avatar
Camil Staps committed
455 456 457
	getUsages _                  = []

	// Efficient union on sorted lists
458
	mergeUnion :: !['DB'.Index] !['DB'.Index] -> ['DB'.Index]
Camil Staps's avatar
Camil Staps committed
459 460
	mergeUnion [] is = is
	mergeUnion is [] = is
461 462 463 464
	mergeUnion orgis=:[i:is] orgjs=:[j:js]
	| i < j     = [i:mergeUnion is orgjs]
	| i > j     = [j:mergeUnion orgis js]
	| otherwise = [i:mergeUnion is js]
Camil Staps's avatar
Camil Staps committed
465

466 467 468 469 470 471 472 473
	mergeUnionWithAnnots :: ![('DB'.Index,a)] ![('DB'.Index,a)] -> [('DB'.Index,a)]
	mergeUnionWithAnnots [] is = is
	mergeUnionWithAnnots is [] = is
	mergeUnionWithAnnots orgis=:[a=:(i,_):is] orgjs=:[b=:(j,_):js]
	| i < j     = [a:mergeUnionWithAnnots is orgjs]
	| i > j     = [b:mergeUnionWithAnnots orgis js]
	| otherwise = [a:mergeUnionWithAnnots is js]

Camil Staps's avatar
Camil Staps committed
474 475 476 477 478 479 480 481
	// Efficient intersection on sorted lists
	mergeIntersect :: !['DB'.Index] !['DB'.Index] -> ['DB'.Index]
	mergeIntersect [] is = []
	mergeIntersect is [] = []
	mergeIntersect orgis=:['DB'.Index i:is] orgjs=:['DB'.Index j:js]
	| i < j     = mergeIntersect is orgjs
	| i > j     = mergeIntersect orgis js
	| otherwise = ['DB'.Index i:mergeIntersect is js]
482

483 484
allTypeSynonyms :: !*CloogleDB -> *(Map Name [TypeDef], *CloogleDB)
allTypeSynonyms wrap=:{db}
Camil Staps's avatar
Camil Staps committed
485
# (es,db) = 'DB'.allEntries db
486 487 488 489 490 491 492
= (fromList
	$ map (\syns=:[(t,_):_] -> (t,map snd syns))
	$ groupBy ((==) `on` fst)
	$ sortBy ((<) `on` fst)
	[(td.td_name, td) \\ TypeDefEntry {tde_typedef=td=:{td_rhs=TDRSynonym t}} <- es]
  , {wrap & db=db}
  )
Camil Staps's avatar
Camil Staps committed
493

494 495 496
alwaysUniquePredicate :: !*CloogleDB -> *(String -> Bool, *CloogleDB)
alwaysUniquePredicate wrap=:{always_unique} = (isJust o flip get always_unique, wrap)

Camil Staps's avatar
Camil Staps committed
497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512
getInstances :: !Name !*CloogleDB -> *([InstanceEntry], *CloogleDB)
getInstances c wrap=:{db,instance_map}
| isNothing idxs = ([], wrap)
# (es,db) = 'DB'.getIndices (fromJust idxs) db
= ([ie \\ {value=InstanceEntry ie} <- es], {wrap & db=db})
where
	idxs = get c instance_map

getDerivations :: !Name !*CloogleDB -> *([DeriveEntry], *CloogleDB)
getDerivations c wrap=:{db,derive_map}
| isNothing idxs = ([], wrap)
# (es,db) = 'DB'.getIndices (fromJust idxs) db
= ([de \\ {value=DeriveEntry de} <- es], {wrap & db=db})
where
	idxs = get c derive_map

513 514 515 516 517
removeContainedEntries :: !*CloogleDB -> *CloogleDB
removeContainedEntries wrap=:{db}
# (es,db) = 'DB'.getEntriesWithIndices db
= {wrap & db=foldr remove db es}
where
518 519 520
	remove :: !(Index, !CloogleEntry, [Annotation]) !*(NativeDB CloogleEntry Annotation)
		-> *NativeDB CloogleEntry Annotation
	remove (idx,e,annots) db = case e of
521 522 523
		FunctionEntry {fe_typedef=Just tdi}
			# (tde,db) = 'DB'.getIndex tdi db
			| not tde.included = db
524
			# newannots = updateAnnots annots tde.annotations
Camil Staps's avatar
Camil Staps committed
525
			= 'DB'.searchIndex tdi newannots $ 'DB'.unsearchIndex idx db
526 527 528
		FunctionEntry {fe_class=Just ci}
			# (ce,db) = 'DB'.getIndex ci db
			| not ce.included = db
529
			# newannots = updateAnnots annots ce.annotations
Camil Staps's avatar
Camil Staps committed
530
			= 'DB'.searchIndex ci newannots  $ 'DB'.unsearchIndex idx db
531 532
		_   = db
	where
533
		updateAnnots :: ![Annotation] ![Annotation] -> [Annotation]
534
		updateAnnots [] m = m
535 536 537 538 539 540 541 542
		updateAnnots [MatchingNGramsQuery r:as] m
			= updateAnnots as [MatchingNGramsQuery $ maxList [r:[r \\ MatchingNGramsQuery r <- match]]:nomatch]
		where (match,nomatch) = partition (\a->a=:MatchingNGramsQuery _) m
		updateAnnots [MatchingNGramsResult r:as] m
			= updateAnnots as [MatchingNGramsResult $ maxList [r:[r \\ MatchingNGramsResult r <- match]]:nomatch]
		where (match,nomatch) = partition (\a->a=:MatchingNGramsResult _) m
		updateAnnots [a=:Unifier _:as]              m = updateAnnots as [a:[a \\ a <- m | not (a=:Unifier _)]]
		updateAnnots [a=:ExactResult:as]            m = updateAnnots as [a:[a \\ a <- m | not a=:ExactResult]]
543 544

getEntries :: !*CloogleDB -> *([(CloogleEntry, [Annotation])], *CloogleDB)
545 546 547
getEntries wrap=:{db}
# (es,db) = 'DB'.getEntries db
= (es, {wrap & db=db})