Verified Commit dd1c2803 authored by Camil Staps's avatar Camil Staps 🚀

Resolve always-unique types before unification (clean-cloogle/cloogle.org#165)

parent ad802392
Subproject commit 2bbfe562f0645de570b511f8a8b161bb08e685da
Subproject commit c68334f3df6257e0a17259974a0ec25278981d0c
......@@ -23,18 +23,19 @@ from TypeTree import :: TypeTree
* A storage for function types, class definitions, type definitions, etc.
*/
:: *CloogleDB =
{ db :: !*DB CloogleEntry AnnotationKey Int //* Core data
, name_ngrams :: !NGramIndex Index //* Name ngrams
, name_map :: !Map Name [Index] //* For exact name search
, types :: !TypeTree Index //* Types, map to FunctionEntries
, core :: ![Index] //* Entries in core modules
, apps :: ![Index] //* Entries in app modules
, builtins :: ![Index] //* Entries in Clean core
, syntax :: ![Index] //* SyntaxEntries
, library_map :: !Map Name [Index] //* Entries by library name
, module_map :: !Map Name [Index] //* Entries by module name
, derive_map :: !Map Name [Index] //* DeriveEntries by generic name
, instance_map :: !Map Name [Index] //* InstanceEntries by class name
{ db :: !*DB CloogleEntry AnnotationKey Int //* Core data
, name_ngrams :: !NGramIndex Index //* Name ngrams
, name_map :: !Map Name [Index] //* For exact name search
, types :: !TypeTree Index //* Types, map to FunctionEntries
, core :: ![Index] //* Entries in core modules
, apps :: ![Index] //* Entries in app modules
, builtins :: ![Index] //* Entries in Clean core
, syntax :: ![Index] //* SyntaxEntries
, library_map :: !Map Name [Index] //* Entries by library name
, module_map :: !Map Name [Index] //* Entries by module name
, derive_map :: !Map Name [Index] //* DeriveEntries by generic name
, instance_map :: !Map Name [Index] //* InstanceEntries by class name
, always_unique :: !Map Name () //* Types that are always unique, like World
}
/**
......@@ -259,6 +260,7 @@ filterUnifying :: !Type !*CloogleDB -> *CloogleDB
filterUsages :: [String] !*CloogleDB -> *CloogleDB
allTypeSynonyms :: !*CloogleDB -> *(Map Name [TypeDef], *CloogleDB)
alwaysUniquePredicate :: !*CloogleDB -> *(String -> Bool, *CloogleDB)
getInstances :: !Name !*CloogleDB -> *([InstanceEntry], *CloogleDB)
getDerivations :: !Name !*CloogleDB -> *([DeriveEntry], *CloogleDB)
......
......@@ -227,7 +227,8 @@ classContext :: ClassEntry -> [TypeRestriction]
classContext ce = ce.ce_context
saveDB :: *CloogleDB *File -> *(*CloogleDB, *File)
saveDB wrapper=:{db,name_ngrams,name_map,types,core,apps,builtins,syntax,library_map,module_map,derive_map,instance_map} f
saveDB wrapper=:{db,name_ngrams,name_map,types,core,apps,builtins,syntax,
library_map,module_map,derive_map,instance_map,always_unique} f
# (db,f) = 'DB'.saveDB db f
# f = write name_ngrams f
# f = write name_map f
......@@ -240,6 +241,7 @@ saveDB wrapper=:{db,name_ngrams,name_map,types,core,apps,builtins,syntax,library
# f = write module_map f
# f = write derive_map f
# f = write instance_map f
# f = write always_unique f
= ({wrapper & db=db}, f)
where
write :: a *File -> *File | JSONEncode{|*|} a
......@@ -260,6 +262,7 @@ openDB f
# (module_map,f) = read f
# (derive_map,f) = read f
# (instance_map,f) = read f
# (always_unique,f) = read f
= (
name_ngrams >>= \name_ngrams ->
name_map >>= \name_map ->
......@@ -271,7 +274,8 @@ openDB f
library_map >>= \library_map ->
module_map >>= \module_map ->
derive_map >>= \derive_map ->
instance_map >>= \instance_map -> Just
instance_map >>= \instance_map ->
always_unique >>= \always_unique -> Just
{ db=fromJust db
, name_ngrams=name_ngrams
, name_map=name_map
......@@ -284,6 +288,7 @@ openDB f
, module_map=module_map
, derive_map=derive_map
, instance_map=instance_map
, always_unique=always_unique
}, f)
where
read :: *File -> *(Maybe a, *File) | JSONDecode{|*|} a
......@@ -490,6 +495,9 @@ allTypeSynonyms wrap=:{db}
, {wrap & db=db}
)
alwaysUniquePredicate :: !*CloogleDB -> *(String -> Bool, *CloogleDB)
alwaysUniquePredicate wrap=:{always_unique} = (isJust o flip get always_unique, wrap)
getInstances :: !Name !*CloogleDB -> *([InstanceEntry], *CloogleDB)
getInstances c wrap=:{db,instance_map}
| isNothing idxs = ([], wrap)
......
......@@ -126,7 +126,7 @@ finaliseDB extra tdb =
Just is -> Just [i:is]) 'M'.newMap
[('CDB'.getName loc, i) \\ (i,e) <- entridxs, Just loc <- ['CDB'.getLocation e]]
, types = foldr (uncurry addType) zero
[(snd $ 'T'.prepare_unification False synonymmap $ 'T'.removeTypeContexts t,i)
[(snd $ 'T'.prepare_unification False alwaysUnique synonymmap $ 'T'.removeTypeContexts t,i)
\\ (i,FunctionEntry fe) <- entridxs, Just t <- [fe.fe_type <|> (docType =<< fe.fe_documentation)]]
, core = coreidxs
, apps = appidxs
......@@ -142,6 +142,7 @@ finaliseDB extra tdb =
$ map (\is=:[(c,_):_] -> (c,map snd is))
$ groupBy ((==) `on` fst) $ sort
[(ie.ie_class, i) \\ (i,InstanceEntry ie) <- entridxs]
, always_unique = always_unique
}
where
entries = [link i e \\ Right e <- filter (\e -> e=:(Right _)) entries` & i <- [0..]]
......@@ -291,6 +292,10 @@ where
\\ TypeDefEntry tde <- entries
| ('T'.td_rhs ('CDB'.getTypeDef tde))=:('T'.TDRSynonym _)]
always_unique = 'M'.fromList
[('T'.td_name $ 'CDB'.getTypeDef tde, ()) \\ TypeDefEntry tde <- entries | 'T'.td_uniq $ 'CDB'.getTypeDef tde]
alwaysUnique = isJust o flip 'M'.get always_unique
// Exclude Root Library Aux Base module
findModules :: ![String] !String !'CDB'.Library !a !String !*World
-> *(![('CDB'.Library, 'CDB'.Module, a)], !*World)
......
......@@ -71,7 +71,8 @@ search {unify,name,className,typeName,using,modules,libraries,page,include_built
# strat = addStrategy (SSClassName <$> className) strat
// Unification search
# (allsyns,cdb) = allTypeSynonyms cdb
# mbPreppedType = prepare_unification True allsyns <$> (unify >>= parseType o fromString)
# (alwaysUnique,cdb) = alwaysUniquePredicate cdb
# mbPreppedType = prepare_unification True alwaysUnique allsyns <$> (unify >>= parseType o fromString)
# usedSynonyms = 'Foldable'.concat (fst <$> mbPreppedType)
# mbType = snd <$> mbPreppedType
# strat = addStrategy (SSUnify <$> mbType) strat
......@@ -95,7 +96,8 @@ 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
# unif = prepare_unification False allsyns <$> fe.fe_type >>= \(syns,type) ->
# (alwaysUnique,db) = alwaysUniquePredicate db
# unif = prepare_unification False alwaysUnique allsyns <$> fe.fe_type >>= \(syns,type) ->
finish_unification (syns ++ usedsyns) <$>
(orgsearchtype >>= unify type)
// Required Context
......
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