Verified Commit 96f1ea60 authored by Camil Staps's avatar Camil Staps
Browse files

More logical indexing pipeline

parent f700b326
...@@ -88,6 +88,12 @@ derive JSONDecode CloogleEntry ...@@ -88,6 +88,12 @@ derive JSONDecode CloogleEntry
| Builtin !Name ![CleanLangReportLocation] //* A language builtin | Builtin !Name ![CleanLangReportLocation] //* A language builtin
| NoLocation //* Only used internally | NoLocation //* Only used internally
/**
* Wrapper around {{`Location`}} for use in {{`CloogleDBFactory`}} to avoid
* name clashes with {{`Module`}} in the compiler.
*/
location :: !Library !String !FilePath !LineNr !LineNr !Name -> Location
/** /**
* Not-type information that is often associated with things that have a type * Not-type information that is often associated with things that have a type
*/ */
......
...@@ -145,6 +145,9 @@ where ...@@ -145,6 +145,9 @@ where
m [c:p] [x:s] = c == x && m p s m [c:p] [x:s] = c == x && m p s
m _ _ = False m _ _ = False
location :: !Library !String !FilePath !LineNr !LineNr !Name -> Location
location lib mod fp dcl icl name = Location lib mod fp dcl icl name
instance getLocation FunctionEntry where getLocation fe = Just fe.fe_loc instance getLocation FunctionEntry where getLocation fe = Just fe.fe_loc
instance getLocation TypeDefEntry where getLocation tde = Just tde.tde_loc instance getLocation TypeDefEntry where getLocation tde = Just tde.tde_loc
instance getLocation ModuleEntry where getLocation me = Just me.me_loc instance getLocation ModuleEntry where getLocation me = Just me.me_loc
......
...@@ -13,23 +13,45 @@ import CloogleDB ...@@ -13,23 +13,45 @@ import CloogleDB
newTemporaryDB :: TemporaryDB newTemporaryDB :: TemporaryDB
finaliseDB :: ![CloogleEntry] !TemporaryDB -> *CloogleDB finaliseDB :: ![CloogleEntry] !TemporaryDB -> *CloogleDB
/**
* Something to index (typically, a library).
*/
:: IndexItem =
{ name :: !String //* The name of the library
, fetch_url :: !SourceURL //* Where to find the code to index
, info_url :: !Maybe String //* Where to find more information
, path :: !Maybe String //* The path to the root
, pattern_exclude :: !Maybe [PathPattern] //* Modules to exclude
, pattern_core :: !Maybe [PathPattern] //* Modules that should be marked as core
, pattern_app :: !Maybe [PathPattern] //* Modules that should be marked as app
}
/**
* A place to get a Clean library.
*/
:: SourceURL
= SVN !String
| Git !String
| CleanDistribution !String
/**
* Patterns on file paths.
*/
:: PathPattern
= PStartsWith !String
| PNot !PathPattern
| PWildcard
/** /**
* Find all modules that could be indexed * Find all modules that could be indexed
* *
* @param Excluded modules. If the path contains any of the strings in this
* parameter, a module will not be considered.
* @param The root of the library directory (typically $CLEAN_HOME/lib). * @param The root of the library directory (typically $CLEAN_HOME/lib).
* @param The library to look in. * @param The {{`IndexItem`}} to look in.
* @param Some auxiliary value to store with the modules. * @param The base path to look in.
* @param A part of the module hierarchy to look for. The empty string to look
* in the whole library, otherwise e.g. Crypto.Hash to only include modules
* in that hierarchy.
* @param The World. * @param The World.
* @result A list of modules found (library, module, whether it is part of the * @result A list of modules found.
* library core, whether it is an app).
*/ */
findModules :: ![String] !String !Library !a !String !*World findModules :: !String !IndexItem !String !*World -> *(![ModuleEntry], !*World)
-> *(![(Library, Module, a)], !*World)
/** /**
* Update a database with all the information found in a module * Update a database with all the information found in a module
...@@ -37,14 +59,11 @@ findModules :: ![String] !String !Library !a !String !*World ...@@ -37,14 +59,11 @@ findModules :: ![String] !String !Library !a !String !*World
* @param Whether local definitions (that only exist in the icl) should be indexed. * @param Whether local definitions (that only exist in the icl) should be indexed.
* @param The root of the library directory (typically $CLEAN_HOME/lib). * @param The root of the library directory (typically $CLEAN_HOME/lib).
* @param The module to index. * @param The module to index.
* @param The library the module to index is in.
* @param A function to update module information (to set me_is_core, me_is_app). * @param A function to update module information (to set me_is_core, me_is_app).
* @param The old database. * @param The old database.
* @result The new database. * @result The new database.
*/ */
indexModule :: !Bool !String !Module !Library indexModule :: !Bool !String !ModuleEntry !TemporaryDB !*World -> *(!TemporaryDB, !*World)
!(String ModuleEntry -> ModuleEntry) !TemporaryDB !*World
-> *(!TemporaryDB, !*World)
:: LocationInModule = :: LocationInModule =
{ dcl_line :: Maybe Int { dcl_line :: Maybe Int
......
...@@ -26,7 +26,8 @@ import qualified Data.Set as S ...@@ -26,7 +26,8 @@ import qualified Data.Set as S
import Data.Tuple import Data.Tuple
import System.Directory import System.Directory
import System.FilePath import System.FilePath
from Text import class Text(concat,indexOf,replaceSubString), instance Text String, <+ from Text import class Text(concat,indexOf,replaceSubString,startsWith),
instance Text String, <+
import CleanPrettyPrint import CleanPrettyPrint
...@@ -71,7 +72,8 @@ from NGramIndex import :: NGramIndex, newNGramIndex, index ...@@ -71,7 +72,8 @@ from NGramIndex import :: NGramIndex, newNGramIndex, index
from TypeTree import :: TypeTree, instance zero (TypeTree v), addType from TypeTree import :: TypeTree, instance zero (TypeTree v), addType
from CloogleDB import from CloogleDB import
:: CloogleDB{..}, :: AnnotationKey, :: CloogleDB{..}, :: AnnotationKey,
:: Location(Location,Builtin,NoLocation), :: Library,
:: Location(Builtin,NoLocation),
:: CleanLangReportLocation, :: CleanLangReportLocation,
:: CloogleEntry(..), :: CloogleEntry(..),
:: ModuleEntry{..}, :: ModuleEntry{..},
...@@ -84,7 +86,8 @@ from CloogleDB import ...@@ -84,7 +86,8 @@ from CloogleDB import
:: DeriveEntry{..}, :: DeriveEntry{..},
instance zero FunctionEntry, instance zero ModuleEntry, instance zero FunctionEntry, instance zero ModuleEntry,
class getLocation, instance getLocation CloogleEntry, class getLocation, instance getLocation CloogleEntry,
instance == Location instance == Location,
location
from Cloogle import instance == FunctionKind from Cloogle import instance == FunctionKind
from Doc import :: ModuleDoc, :: FunctionDoc{..}, :: ClassDoc, :: TypeDoc{..}, from Doc import :: ModuleDoc, :: FunctionDoc{..}, :: ClassDoc, :: TypeDoc{..},
:: ConstructorDoc, :: ClassMemberDoc, :: Description, :: ConstructorDoc, :: ClassMemberDoc, :: Description,
...@@ -127,11 +130,11 @@ where ...@@ -127,11 +130,11 @@ where
instance < Location instance < Location
where where
< (Location l1 m1 _ d1 i1 n1) (Location l2 m2 _ d2 i2 n2) < ('CDB'.Location l1 m1 _ d1 i1 n1) ('CDB'.Location l2 m2 _ d2 i2 n2)
= ((l1,m1,n1),(d1,i1)) < ((l2,m2,n2), (d2,i2)) = ((l1,m1,n1),(d1,i1)) < ((l2,m2,n2), (d2,i2))
< (Location _ _ _ _ _ _) _ < ('CDB'.Location _ _ _ _ _ _) _
= True = True
< _ (Location _ _ _ _ _ _) < _ ('CDB'.Location _ _ _ _ _ _)
= False = False
< (Builtin a _) (Builtin b _) < (Builtin a _) (Builtin b _)
= a < b = a < b
...@@ -140,6 +143,21 @@ where ...@@ -140,6 +143,21 @@ where
< _ _ < _ _
= False = False
class match a :: !a !FilePath -> Bool
instance match PathPattern
where
match (PStartsWith s) fp = startsWith s fp
match (PNot p) fp = not (match p fp)
match PWildcard _ = True
instance match (Maybe m) | match m
where
match Nothing s = False
match (Just m) s = match m s
instance match [PathPattern] where match ps fp = any (flip match fp) ps
finaliseDB :: ![CloogleEntry] !TemporaryDB -> *'CDB'.CloogleDB finaliseDB :: ![CloogleEntry] !TemporaryDB -> *'CDB'.CloogleDB
finaliseDB extra tdb = finaliseDB extra tdb =
{ db = 'DB'.mapInPlace link $ newDB entries { db = 'DB'.mapInPlace link $ newDB entries
...@@ -349,29 +367,38 @@ where ...@@ -349,29 +367,38 @@ where
[('T'.td_name $ 'CDB'.getTypeDef tde, ()) \\ TypeDefEntry tde <- entries | 'T'.td_uniq $ 'CDB'.getTypeDef tde] [('T'.td_name $ 'CDB'.getTypeDef tde, ()) \\ TypeDefEntry tde <- entries | 'T'.td_uniq $ 'CDB'.getTypeDef tde]
alwaysUnique = isJust o flip 'M'.get always_unique alwaysUnique = isJust o flip 'M'.get always_unique
// Exclude Root Library Aux Base module findModules :: !String !IndexItem !String !*World -> *(!['CDB'.ModuleEntry], !*World)
findModules :: ![String] !String !'CDB'.Library !a !String !*World findModules root item base w
-> *(![('CDB'.Library, 'CDB'.Module, a)], !*World) | match item.pattern_exclude path = ([], w)
findModules ex root lib aux base w #! (fps, w) = readDirectory fullpath w
| any ((<>) -1 o flip indexOf path) ex = ([], w)
#! (fps, w) = readDirectory path w
| isError fps = ([], w) | isError fps = ([], w)
#! (Ok fps) = fps #! (Ok fps) = fps
#! mods = map (\s -> let mod = basedot +++ s % (0, size s - 5) in #! mods = map makeEntry $ filter included $ filter isIclModule fps
(lib, mod, aux)) $ filter included $ filter isIclModule fps #! (moremodss,w) = mapSt (findModules root item o ((+++) basedot)) (filter isDirectory fps) w
#! (moremodss,w) = mapSt (findModules ex root lib aux o ((+++) basedot)) (filter isDirectory fps) w = (removeDupBy (\m -> 'CDB'.getName m.me_loc) (mods ++ flatten moremodss), w)
= (removeDupBy (\(l,m,_)->(l,m)) (mods ++ flatten moremodss), w)
where where
basedot = if (base == "") "" (base +++ ".") basedot = if (base == "") "" (base +++ ".")
path = root </?> lib </?> replaceSubString "." {pathSeparator} base path = replaceSubString "." {pathSeparator} base
where fullpath = root </?> item.IndexItem.name </?> path
(</?>) infixr 5 :: !FilePath !FilePath -> FilePath (</?>) infixr 5 :: !FilePath !FilePath -> FilePath
(</?>) "" p = p (</?>) "" p = p
(</?>) p "" = p (</?>) p "" = p
(</?>) p1 p2 = p1 </> p2 (</?>) p1 p2 = p1 </> p2
makeEntry :: String -> 'CDB'.ModuleEntry
makeEntry fn =
{ me_loc = location item.IndexItem.name modname (base </?> fn) (Just 1) (Just 1) modname
, me_is_core = match item.pattern_core (path </> fn)
, me_is_app = match item.pattern_app (path </> fn)
, me_documentation = Nothing
, me_usages = []
}
where
modname = basedot +++ fn % (0, size fn - 5)
included :: String -> Bool included :: String -> Bool
included s = not (any ((<>) -1 o flip indexOf (path </> s)) ex) included s = not (match item.pattern_exclude (path </> s))
isIclModule :: String -> Bool isIclModule :: String -> Bool
isIclModule s = s % (size s - 4, size s - 1) == ".icl" isIclModule s = s % (size s - 4, size s - 1) == ".icl"
...@@ -383,14 +410,13 @@ where ...@@ -383,14 +410,13 @@ where
removeDupBy f [x:xs] = [x:removeDupBy f (filter ((<>) (f x) o f) xs)] removeDupBy f [x:xs] = [x:removeDupBy f (filter ((<>) (f x) o f) xs)]
removeDupBy _ [] = [] removeDupBy _ [] = []
indexModule :: !Bool !String !'CDB'.Module !'CDB'.Library indexModule :: !Bool !String !'CDB'.ModuleEntry !TemporaryDB !*World
!(String 'CDB'.ModuleEntry -> 'CDB'.ModuleEntry) !TemporaryDB !*World
-> *(!TemporaryDB, !*World) -> *(!TemporaryDB, !*World)
indexModule include_locals root mod lib modf db w indexModule include_locals root mod db w
#! (functions,macros,generics,typedefs,clss,insts,derivs,clsderivs,(modname,modentry,imports),w) #! (functions,macros,generics,typedefs,clss,insts,derivs,clsderivs,(modname,_,imports),w)
= findModuleContents include_locals (root </> lib </> mkdir mod) w = findModuleContents include_locals (root </> lib </> mkdir ('CDB'.getName mod.me_loc)) w
#! typedefs = [{td & tde_loc=castLoc modname loc} \\ (loc,td) <- typedefs] #! typedefs = [{td & tde_loc=castLoc modname loc} \\ (loc,td) <- typedefs]
#! lib = lib % (0, size lib - size modname + size mod - 1) #! lib = lib % (0, size lib - size modname + size ('CDB'.getName mod.me_loc) - 1)
#! db = #! db =
{ db { db
& temp_functions = & temp_functions =
...@@ -403,17 +429,19 @@ indexModule include_locals root mod lib modf db w ...@@ -403,17 +429,19 @@ indexModule include_locals root mod lib modf db w
, temp_instances = [castLocThd3 modname insts:db.temp_instances] , temp_instances = [castLocThd3 modname insts:db.temp_instances]
, temp_derivations = [map (appSnd (castLocThd3 modname)) derivs:db.temp_derivations] , temp_derivations = [map (appSnd (castLocThd3 modname)) derivs:db.temp_derivations]
, temp_class_derivations = [castLocFrth modname clsderivs:db.temp_class_derivations] , temp_class_derivations = [castLocFrth modname clsderivs:db.temp_class_derivations]
, temp_modules = [(modf mod {modentry & me_loc=Location lib modname dclpath (Just 1) (Just 1) modname},imports):db.temp_modules] , temp_modules = [(mod,imports):db.temp_modules]
} }
= (db,w) = (db,w)
where where
lib = fromJust ('CDB'.getLibrary mod.me_loc)
castLocThd3 :: String -> ([(a, b, LocationInModule)] -> [(a, b, 'CDB'.Location)]) castLocThd3 :: String -> ([(a, b, LocationInModule)] -> [(a, b, 'CDB'.Location)])
castLocThd3 m = map (appThd3 (castLoc m)) castLocThd3 m = map (appThd3 (castLoc m))
castLocFrth m = map (\(a,b,c,l) -> (a,b,c,castLoc m l)) castLocFrth m = map (\(a,b,c,l) -> (a,b,c,castLoc m l))
castLoc :: String LocationInModule -> 'CDB'.Location castLoc :: String LocationInModule -> 'CDB'.Location
castLoc m l = 'CDB'.Location lib m dclpath l.dcl_line l.icl_line $ fromMaybe "" l.name castLoc m l = location lib m dclpath l.dcl_line l.icl_line $ fromMaybe "" l.LocationInModule.name
dclpath = mkdir mod +++ ".dcl" dclpath = mkdir ('CDB'.getName mod.me_loc) +++ ".dcl"
mkdir :: String -> String mkdir :: String -> String
mkdir s = { if (c == '.') '/' c \\ c <-: s } mkdir s = { if (c == '.') '/' c \\ c <-: s }
...@@ -463,7 +491,7 @@ findModuleContents include_locals path w ...@@ -463,7 +491,7 @@ findModuleContents include_locals path w
, filter (not o isEmpty o snd) (map (appSnd (filter (hasDcl o thd3))) derivs) , filter (not o isEmpty o snd) (map (appSnd (filter (hasDcl o thd3))) derivs)
, filter (hasDcl o (\(_,_,_,x)->x)) clsderivs , filter (hasDcl o (\(_,_,_,x)->x)) clsderivs
) with hasDcl loc = isJust loc.dcl_line ) with hasDcl loc = isJust loc.dcl_line
#! rules = filter (\(r,_,_) -> not $ any (\(l,_,_)->fromJust l.name == fromJust r.name) functions) rules #! rules = filter (\(r,_,_) -> not $ any (\(l,_,_)->fromJust l.LocationInModule.name == fromJust r.LocationInModule.name) functions) rules
= (functions,rules,generics,typedefs,clss,insts,derivs,clsderivs,(modname,pd_module dcl,imports),w) = (functions,rules,generics,typedefs,clss,insts,derivs,clsderivs,(modname,pd_module dcl,imports),w)
where where
combine :: (a a -> Bool) (a a -> a) combine :: (a a -> Bool) (a a -> a)
...@@ -483,7 +511,7 @@ where ...@@ -483,7 +511,7 @@ where
(found,xs) -> let (foundys,ys`) = partition (eq y) ys in (found,xs) -> let (foundys,ys`) = partition (eq y) ys in
[foldr join y (found ++ foundys):unionBy eq join xs ys`] [foldr join y (found ++ foundys):unionBy eq join xs ys`]
cmpLoc x y = x.name == y.name cmpLoc x y = x.LocationInModule.name == y.LocationInModule.name
cmpLocFst :: ((LocationInModule, a) (LocationInModule, a) -> Bool) cmpLocFst :: ((LocationInModule, a) (LocationInModule, a) -> Bool)
cmpLocFst = cmpLoc `on` fst cmpLocFst = cmpLoc `on` fst
...@@ -523,7 +551,7 @@ where ...@@ -523,7 +551,7 @@ where
joinLoc a b = joinLoc a b =
{ dcl_line = a.dcl_line <|> b.dcl_line { dcl_line = a.dcl_line <|> b.dcl_line
, icl_line = a.icl_line <|> b.icl_line , icl_line = a.icl_line <|> b.icl_line
, name = a.name <|> b.name , name = a.LocationInModule.name <|> b.LocationInModule.name
} }
pd_module :: ![ParsedDefinition] -> ModuleEntry pd_module :: ![ParsedDefinition] -> ModuleEntry
...@@ -535,7 +563,7 @@ where ...@@ -535,7 +563,7 @@ where
pd_rewriterules :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.FunctionEntry, 'S'.Set String)] pd_rewriterules :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.FunctionEntry, 'S'.Set String)]
pd_rewriterules dcl defs st pd_rewriterules dcl defs st
= [( setLine dcl pos {zero & name=Just id.id_name} = [( setLine dcl pos {LocationInModule | zero & name=Just id.id_name}
, let doc = findDoc hideIsUsedReturn id st in , let doc = findDoc hideIsUsedReturn id st in
trace_type_warning id trace_type_warning id
{ zero { zero
...@@ -578,7 +606,7 @@ where ...@@ -578,7 +606,7 @@ where
pd_generics :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.FunctionEntry, 'S'.Set String)] pd_generics :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.FunctionEntry, 'S'.Set String)]
pd_generics dcl defs st pd_generics dcl defs st
= [( setLine dcl gen_pos {zero & name=Just id_name} = [( setLine dcl gen_pos {LocationInModule | zero & name=Just id_name}
, { zero , { zero
& fe_type=Just $ 'T'.toType gen_type & fe_type=Just $ 'T'.toType gen_type
, fe_generic_vars=Just $ map 'T'.toTypeVar gen_vars , fe_generic_vars=Just $ map 'T'.toTypeVar gen_vars
...@@ -591,7 +619,7 @@ where ...@@ -591,7 +619,7 @@ where
pd_typespecs :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.FunctionEntry, 'S'.Set String)] pd_typespecs :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.FunctionEntry, 'S'.Set String)]
pd_typespecs dcl defs st pd_typespecs dcl defs st
= [( setLine dcl pos {zero & name=Just id_name} = [( setLine dcl pos {LocationInModule | zero & name=Just id_name}
, { zero , { zero
& fe_type=Just $ 'T'.toType t & fe_type=Just $ 'T'.toType t
, fe_priority = 'T'.toMaybePriority p , fe_priority = 'T'.toMaybePriority p
...@@ -618,7 +646,7 @@ where ...@@ -618,7 +646,7 @@ where
pd_classes dcl defs st pd_classes dcl defs st
= [ let = [ let
typespecs = pd_typespecs True clsdefs st typespecs = pd_typespecs True clsdefs st
macros = [(n,(r,ids)) \\ ({name=Just n},{fe_representation=Just r},ids) <- pd_rewriterules dcl clsdefs st] macros = [(n,(r,ids)) \\ ({LocationInModule | name=Just n},{fe_representation=Just r},ids) <- pd_rewriterules dcl clsdefs st]
updateRepresentation n fe updateRepresentation n fe
= { fe = { fe
& fe_kind=if (isNothing $ lookup n macros) fe.fe_kind Macro & fe_kind=if (isNothing $ lookup n macros) fe.fe_kind Macro
...@@ -627,8 +655,8 @@ where ...@@ -627,8 +655,8 @@ where
((\d -> {FunctionDoc | d & vars=[]}) <$> findDoc hideIsUsedReturn id st) ((\d -> {FunctionDoc | d & vars=[]}) <$> findDoc hideIsUsedReturn id st)
fe.fe_documentation fe.fe_documentation
} }
members = [(f,updateRepresentation f et,ids) \\ ({name=Just f}, et, ids) <- typespecs] members = [(f,updateRepresentation f et,ids) \\ ({LocationInModule | name=Just f}, et, ids) <- typespecs]
in ( setLine dcl class_pos {zero & name=Just id_name} in ( setLine dcl class_pos {LocationInModule | zero & name=Just id_name}
, 'CDB'.toClass , 'CDB'.toClass
NoLocation NoLocation
(map 'T'.toTypeVar class_args) (map 'T'.toTypeVar class_args)
...@@ -655,7 +683,7 @@ where ...@@ -655,7 +683,7 @@ where
isSingleFunction :: [(LocationInModule, 'CDB'.FunctionEntry, a)] Ident -> Bool isSingleFunction :: [(LocationInModule, 'CDB'.FunctionEntry, a)] Ident -> Bool
isSingleFunction members id = length members == 1 isSingleFunction members id = length members == 1
&& fromJust (fst3 $ hd members).name == id.id_name && fromJust (fst3 $ hd members).LocationInModule.name == id.id_name
// Hide warnings about @result and @param on single function classes // Hide warnings about @result and @param on single function classes
hideFunctionOnClass (IllegalField "param") = False hideFunctionOnClass (IllegalField "param") = False
...@@ -665,7 +693,7 @@ where ...@@ -665,7 +693,7 @@ where
pd_types :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.TypeDefEntry)] pd_types :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.TypeDefEntry)]
pd_types dcl defs st pd_types dcl defs st
= [let name = 'T'.td_name td in = [let name = 'T'.td_name td in
( setLine dcl ptd.td_pos {zero & name=Just name} ( setLine dcl ptd.td_pos {LocationInModule | zero & name=Just name}
, 'CDB'.toTypeDefEntry NoLocation td $ Just $ findRhsDoc ptd $ fromMaybe gDefault{|*|} $ , 'CDB'.toTypeDefEntry NoLocation td $ Just $ findRhsDoc ptd $ fromMaybe gDefault{|*|} $
findDoc (const True) ptd.td_ident st findDoc (const True) ptd.td_ident st
) \\ PD_Type ptd <- defs, td <- ['T'.toTypeDef ptd]] ) \\ PD_Type ptd <- defs, td <- ['T'.toTypeDef ptd]]
......
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