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

Make work on the master compiler

parent 003941f8
Subproject commit 42403fe26924d3ceab328c44f20f8aad4b710468
Subproject commit 38ddb57139493f82fbb31eaedf1b5eeaea002eb9
......@@ -28,11 +28,11 @@ from Data.Map import :: Map(..), elems, filterWithKey, foldrNoKey,
toAscList, toList, instance Functor (Map k)
import Data.Maybe
import Data.NGramIndex
import qualified Data.NGramIndex as NGrams
import qualified Data.NGramIndex
import Data.Tuple
from Database.Native import :: NativeDB, :: Index, :: Entry{..},
:: SearchMode(..), instance == Index, instance < Index
import qualified Database.Native as DB
import qualified Database.Native
import Database.Native.JSON
import System.File
import System.FilePath
......@@ -216,7 +216,7 @@ classContext ce = ce.ce_context
saveDB :: !*CloogleDB !*File -> *(!*CloogleDB, !*File)
saveDB wrapper=:{db,name_ngrams,name_map,types,core,apps,builtins,syntax,
abc_instrs,library_map,module_map,derive_map,instance_map,always_unique} f
# (db,f) = 'DB'.saveDB db f
# (db,f) = 'Database.Native'.saveDB db f
# f = write name_ngrams f
# f = write name_map f
# f = write types f
......@@ -237,7 +237,7 @@ where
openDB :: !*File -> *(!Maybe *CloogleDB, !*File)
openDB f
# ((ok,db),f) = appFst isJustU $ 'DB'.openDB f
# ((ok,db),f) = appFst isJustU $ 'Database.Native'.openDB f
| not ok = (Nothing, f)
# (name_ngrams,f) = read f
# (name_map,f) = read f
......@@ -293,11 +293,11 @@ where
(>>=) (Just x) f = f x
resetDB :: !*CloogleDB -> *CloogleDB
resetDB wrap=:{db} = {wrap & db='DB'.resetDB db}
resetDB wrap=:{db} = {wrap & db='Database.Native'.resetDB db}
dbStats :: !*CloogleDB -> *(CloogleDBStats, *CloogleDB)
dbStats wrap=:{db,types}
# (es,db) = 'DB'.allEntries db
# (es,db) = 'Database.Native'.allEntries db
# stats = foldr count zero es
= (stats, {wrap & db=db})
where
......@@ -333,63 +333,63 @@ writeTypeTree db=:{types} f
getIndex :: !Index !*CloogleDB -> *(Entry CloogleEntry Annotation, *CloogleDB)
getIndex idx wrap=:{db}
# (e,db) = 'DB'.getIndex idx db
# (e,db) = 'Database.Native'.getIndex idx db
= (e, {wrap & db=db})
getIndices :: ![Index] !*CloogleDB -> *([Entry CloogleEntry Annotation], *CloogleDB)
getIndices idxs wrap=:{db}
# (es,db) = 'DB'.getIndices idxs db
# (es,db) = 'Database.Native'.getIndices idxs db
= (es, {wrap & db=db})
filterDB :: (CloogleEntry -> Bool) !*CloogleDB -> *CloogleDB
filterDB f db = {db & db = 'DB'.search Intersect (\v -> (f v, [])) db.db}
filterDB f db = {db & db = 'Database.Native'.search Intersect (\v -> (f v, [])) db.db}
excludeCore :: !*CloogleDB -> *CloogleDB
excludeCore wrap=:{db,core}
# db = 'DB'.unsearchIndices core db
# db = 'Database.Native'.unsearchIndices core db
= {wrap & db=db}
excludeApps :: !*CloogleDB -> *CloogleDB
excludeApps wrap=:{db,apps}
# db = 'DB'.unsearchIndices apps db
# db = 'Database.Native'.unsearchIndices apps db
= {wrap & db=db}
excludeBuiltins :: !*CloogleDB -> *CloogleDB
excludeBuiltins wrap=:{db,builtins}
# db = 'DB'.unsearchIndices builtins db
# db = 'Database.Native'.unsearchIndices builtins db
= {wrap & db=db}
includeBuiltins :: !*CloogleDB -> *CloogleDB
includeBuiltins wrap=:{db,builtins}
# db = 'DB'.searchIndices AddExcluded (map (flip tuple []) builtins) db
# db = 'Database.Native'.searchIndices AddExcluded (map (flip tuple []) builtins) db
= {wrap & db=db}
filterLibraries :: ![Name] !*CloogleDB -> *CloogleDB
filterLibraries ss wrap=:{db,library_map}
# db = 'DB'.searchIndices Intersect (map (flip tuple []) idxs) db
# db = 'Database.Native'.searchIndices Intersect (map (flip tuple []) idxs) db
= {wrap & db=db}
where
idxs = foldr merge [] $ catMaybes $ map (flip get library_map) ss
filterModules :: ![Name] !*CloogleDB -> *CloogleDB
filterModules ss wrap=:{db,module_map}
# db = 'DB'.searchIndices Intersect (map (flip tuple []) idxs) db
# db = 'Database.Native'.searchIndices Intersect (map (flip tuple []) idxs) db
= {wrap & db=db}
where
idxs = foldr merge [] $ catMaybes $ map (flip get module_map) ss
filterName :: !String !*CloogleDB -> *CloogleDB
filterName s wrap=:{db,name_ngrams,syntax,abc_instrs}
# (indices,db) = mapSt (uncurry getIndexWithDistance) ('NGrams'.search s name_ngrams) db
# db = 'DB'.searchIndices Intersect indices db
# db = 'DB'.searchWithIndices syntaxSearch syntax db
# db = 'DB'.searchWithIndices abcSearch abc_instrs db
# (indices,db) = mapSt (uncurry getIndexWithDistance) ('Data.NGramIndex'.search s name_ngrams) db
# db = 'Database.Native'.searchIndices Intersect indices db
# db = 'Database.Native'.searchWithIndices syntaxSearch syntax db
# db = 'Database.Native'.searchWithIndices abcSearch abc_instrs db
= {wrap & db=db}
where
getIndexWithDistance :: !Index !Int !*(NativeDB CloogleEntry Annotation)
-> *(!(!Index, ![Annotation]), !*NativeDB CloogleEntry Annotation)
getIndexWithDistance idx n db
# (e,db) = 'DB'.getIndex idx db
# (e,db) = 'Database.Native'.getIndex idx db
# name = getName $ fromJust $ getLocation e.value
# rn = toReal n
# annots =
......@@ -399,7 +399,7 @@ where
= ((idx, annots), db)
cs = [c \\ c <-: s]
qsize = toReal $ max 1 $ length $ 'NGrams'.ngrams NGRAMS_CI NGRAMS_N s
qsize = toReal $ max 1 $ length $ 'Data.NGramIndex'.ngrams NGRAMS_CI NGRAMS_N s
syntaxSearch :: CloogleEntry -> (Bool, [a])
syntaxSearch (SyntaxEntry se) = (any (not o isEmpty o flip match cs) se.syntax_patterns, [])
......@@ -411,14 +411,14 @@ where
filterExactName :: !String !*CloogleDB -> *CloogleDB
filterExactName n wrap=:{db,name_map}
# db = 'DB'.searchIndices Intersect [(i,[ExactResult]) \\ i <- idxs] db
# db = 'Database.Native'.searchIndices Intersect [(i,[ExactResult]) \\ i <- idxs] db
= {wrap & db=db}
where
idxs = fromMaybe [] $ get n name_map
filterUnifying :: !Type !*CloogleDB -> *CloogleDB
filterUnifying t wrap=:{db,types}
# db = 'DB'.searchIndices Intersect idxs db
# db = 'Database.Native'.searchIndices Intersect idxs db
= {wrap & db=db}
where
idxs = sortBy ((<) `on` fst) [(idx,[Unifier u]) \\ (t,u,idxs) <- findUnifying t types, idx <- idxs]
......@@ -429,9 +429,9 @@ filterUsages filter names wrap=:{name_map}
# idxss = map (fromMaybe [] o flip get name_map) names
# nameidxs = [(i,[ExactResult]) \\ i <- sort [i \\ is <- idxss, i <- is]]
# wrap=:{db} = filter wrap
# db = 'DB'.searchIndices Intersect nameidxs db
# db = 'Database.Native'.searchIndices Intersect nameidxs db
// For all lists of entries, the corresponding usages
# (entriess,db) = mapSt 'DB'.getIndices idxss db
# (entriess,db) = mapSt 'Database.Native'.getIndices idxss db
# wrap & db = db
# wrap=:{db} = filter $ resetDB wrap
# usagess = map (foldr mergeUnion [] o map \e -> getUsages e.value) entriess
......@@ -439,12 +439,12 @@ filterUsages filter names wrap=:{name_map}
# usages = case usagess of
[] -> []
us -> foldr1 mergeIntersect us
# (es,db) = 'DB'.getIndices usages db
# (es,db) = 'Database.Native'.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]
# db = 'DB'.searchIndices Intersect (mergeUnionWithAnnots nameidxs [(u,[]) \\ u <- usages]) db
# db = 'Database.Native'.searchIndices Intersect (mergeUnionWithAnnots nameidxs [(u,[]) \\ u <- usages]) db
= {wrap & db=db}
where
getUsages :: !CloogleEntry -> [Index]
......@@ -455,7 +455,7 @@ where
getUsages _ = []
// Efficient union on sorted lists
mergeUnion :: !['DB'.Index] !['DB'.Index] -> ['DB'.Index]
mergeUnion :: !['Database.Native'.Index] !['Database.Native'.Index] -> ['Database.Native'.Index]
mergeUnion [] is = is
mergeUnion is [] = is
mergeUnion orgis=:[i:is] orgjs=:[j:js]
......@@ -463,7 +463,7 @@ where
| i > j = [j:mergeUnion orgis js]
| otherwise = [i:mergeUnion is js]
mergeUnionWithAnnots :: ![('DB'.Index,a)] ![('DB'.Index,a)] -> [('DB'.Index,a)]
mergeUnionWithAnnots :: ![('Database.Native'.Index,a)] ![('Database.Native'.Index,a)] -> [('Database.Native'.Index,a)]
mergeUnionWithAnnots [] is = is
mergeUnionWithAnnots is [] = is
mergeUnionWithAnnots orgis=:[a=:(i,_):is] orgjs=:[b=:(j,_):js]
......@@ -472,17 +472,17 @@ where
| otherwise = [a:mergeUnionWithAnnots is js]
// Efficient intersection on sorted lists
mergeIntersect :: !['DB'.Index] !['DB'.Index] -> ['DB'.Index]
mergeIntersect :: !['Database.Native'.Index] !['Database.Native'.Index] -> ['Database.Native'.Index]
mergeIntersect [] is = []
mergeIntersect is [] = []
mergeIntersect orgis=:['DB'.Index i:is] orgjs=:['DB'.Index j:js]
mergeIntersect orgis=:['Database.Native'.Index i:is] orgjs=:['Database.Native'.Index j:js]
| i < j = mergeIntersect is orgjs
| i > j = mergeIntersect orgis js
| otherwise = ['DB'.Index i:mergeIntersect is js]
| otherwise = ['Database.Native'.Index i:mergeIntersect is js]
allTypeSynonyms :: !*CloogleDB -> *(Map Name [TypeDef], *CloogleDB)
allTypeSynonyms wrap=:{db}
# (es,db) = 'DB'.allEntries db
# (es,db) = 'Database.Native'.allEntries db
= (fromList
$ map (\syns=:[(t,_):_] -> (t,map snd syns))
$ groupBy ((==) `on` fst)
......@@ -497,7 +497,7 @@ alwaysUniquePredicate wrap=:{always_unique} = (isJust o flip get always_unique,
getInstances :: !Name !*CloogleDB -> *([InstanceEntry], *CloogleDB)
getInstances c wrap=:{db,instance_map}
| isNothing idxs = ([], wrap)
# (es,db) = 'DB'.getIndices (fromJust idxs) db
# (es,db) = 'Database.Native'.getIndices (fromJust idxs) db
= ([ie \\ {value=InstanceEntry ie} <- es], {wrap & db=db})
where
idxs = get c instance_map
......@@ -505,29 +505,29 @@ where
getDerivations :: !Name !*CloogleDB -> *([DeriveEntry], *CloogleDB)
getDerivations c wrap=:{db,derive_map}
| isNothing idxs = ([], wrap)
# (es,db) = 'DB'.getIndices (fromJust idxs) db
# (es,db) = 'Database.Native'.getIndices (fromJust idxs) db
= ([de \\ {value=DeriveEntry de} <- es], {wrap & db=db})
where
idxs = get c derive_map
removeContainedEntries :: !*CloogleDB -> *CloogleDB
removeContainedEntries wrap=:{db}
# (es,db) = 'DB'.getEntriesWithIndices db
# (es,db) = 'Database.Native'.getEntriesWithIndices db
= {wrap & db=foldr remove db es}
where
remove :: !(Index, !CloogleEntry, [Annotation]) !*(NativeDB CloogleEntry Annotation)
-> *NativeDB CloogleEntry Annotation
remove (idx,e,annots) db = case e of
FunctionEntry {fe_typedef=Just tdi}
# (tde,db) = 'DB'.getIndex tdi db
# (tde,db) = 'Database.Native'.getIndex tdi db
| not tde.included = db
# newannots = updateAnnots annots tde.annotations
= 'DB'.searchIndex tdi newannots $ 'DB'.unsearchIndex idx db
= 'Database.Native'.searchIndex tdi newannots $ 'Database.Native'.unsearchIndex idx db
FunctionEntry {fe_class=Just ci}
# (ce,db) = 'DB'.getIndex ci db
# (ce,db) = 'Database.Native'.getIndex ci db
| not ce.included = db
# newannots = updateAnnots annots ce.annotations
= 'DB'.searchIndex ci newannots $ 'DB'.unsearchIndex idx db
= 'Database.Native'.searchIndex ci newannots $ 'Database.Native'.unsearchIndex idx db
_ = db
where
updateAnnots :: ![Annotation] ![Annotation] -> [Annotation]
......@@ -543,5 +543,5 @@ where
getEntries :: !*CloogleDB -> *([(CloogleEntry, [Annotation])], *CloogleDB)
getEntries wrap=:{db}
# (es,db) = 'DB'.getEntries db
# (es,db) = 'Database.Native'.getEntries db
= (es, {wrap & db=db})
This diff is collapsed.
......@@ -10,11 +10,10 @@ import StdTuple
import Control.Applicative
import Control.Monad
import qualified Data.Foldable as Foldable
import qualified Data.Foldable
from Data.Func import $, on, `on`, instance Functor ((->) r), mapSt
import Data.Functor
import Data.List
import qualified Data.Map as M
import Data.Maybe
import Data.Maybe.Ord
import Data.Tuple
......@@ -90,7 +89,7 @@ search` {unify,name,className,typeName,using,modules,libraries,page,include_buil
# (allsyns,cdb) = allTypeSynonyms cdb
# (alwaysUnique,cdb) = alwaysUniquePredicate cdb
# mbPreppedType = prepare_unification True alwaysUnique allsyns <$> (unify >>= parseType o fromString)
# usedsyns = 'Foldable'.concat (fst <$> mbPreppedType)
# usedsyns = 'Data.Foldable'.concat (fst <$> mbPreppedType)
# mbType = snd <$> mbPreppedType
# strat = addStrategy (SSUnify <$> mbType) strat
// Usage search
......
......@@ -16,7 +16,7 @@ import Data.Functor
from Data.GenLexOrd import :: LexOrd, generic gLexOrd
import qualified Data.GenLexOrd
from Data.List import instance Foldable []
import qualified Data.Map as M
import qualified Data.Map
import Data.Maybe
import Data.Tuple
import System.Process
......@@ -180,7 +180,7 @@ where
rankConstraints :: ![(Request, RankConstraint)] !*CloogleDB -> *([String], *CloogleDB)
rankConstraints constraints cdb
# (constraints,cdb) = findConstraints constraints 'M'.newMap cdb
# (constraints,cdb) = findConstraints constraints 'Data.Map'.newMap cdb
= (default ++ constraints,cdb)
where
default =
......@@ -205,10 +205,10 @@ findConstraints ::
!(Map Request (!Maybe Type,!Map String [TypeDef],![TypeDef],![(!CloogleEntry,![Annotation])]))
!*CloogleDB -> *([String], *CloogleDB)
findConstraints [(req,LT urid1 urid2):rest] results cdb
# (orgsearchtype,allsyns,usedsyns,entries,cdb) = case 'M'.get req results of
# (orgsearchtype,allsyns,usedsyns,entries,cdb) = case 'Data.Map'.get req results of
Just (t,as,us,es) -> (t,as,us,es,cdb)
_ -> search` req cdb
# results = 'M'.put req (orgsearchtype,allsyns,usedsyns,entries) results
# results = 'Data.Map'.put req (orgsearchtype,allsyns,usedsyns,entries) results
# (e1,annots1,cdb) = findEntry orgsearchtype allsyns usedsyns urid1 entries cdb
# (e2,annots2,cdb) = findEntry orgsearchtype allsyns usedsyns urid2 entries cdb
# ri1 = symbolicDistance e1 annots1
......
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