From 96f1ea6060f46f72c37fe17f83e2c447a5f96a5f Mon Sep 17 00:00:00 2001 From: Camil Staps Date: Wed, 4 Apr 2018 14:30:36 +0200 Subject: [PATCH] More logical indexing pipeline --- CloogleDB.dcl | 6 +++ CloogleDB.icl | 3 ++ CloogleDBFactory.dcl | 49 ++++++++++++------ CloogleDBFactory.icl | 116 +++++++++++++++++++++++++++---------------- 4 files changed, 115 insertions(+), 59 deletions(-) diff --git a/CloogleDB.dcl b/CloogleDB.dcl index bb5c2b7..7015111 100644 --- a/CloogleDB.dcl +++ b/CloogleDB.dcl @@ -88,6 +88,12 @@ derive JSONDecode CloogleEntry | Builtin !Name ![CleanLangReportLocation] //* A language builtin | 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 */ diff --git a/CloogleDB.icl b/CloogleDB.icl index bced6a2..acd3e11 100644 --- a/CloogleDB.icl +++ b/CloogleDB.icl @@ -145,6 +145,9 @@ where m [c:p] [x:s] = c == x && m p s 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 TypeDefEntry where getLocation tde = Just tde.tde_loc instance getLocation ModuleEntry where getLocation me = Just me.me_loc diff --git a/CloogleDBFactory.dcl b/CloogleDBFactory.dcl index 19718b2..5c6f15c 100644 --- a/CloogleDBFactory.dcl +++ b/CloogleDBFactory.dcl @@ -13,23 +13,45 @@ import CloogleDB newTemporaryDB :: TemporaryDB 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 * - * @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 library to look in. - * @param Some auxiliary value to store with the modules. - * @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 {{`IndexItem`}} to look in. + * @param The base path to look in. * @param The World. - * @result A list of modules found (library, module, whether it is part of the - * library core, whether it is an app). + * @result A list of modules found. */ -findModules :: ![String] !String !Library !a !String !*World - -> *(![(Library, Module, a)], !*World) +findModules :: !String !IndexItem !String !*World -> *(![ModuleEntry], !*World) /** * Update a database with all the information found in a module @@ -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 The root of the library directory (typically $CLEAN_HOME/lib). * @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 The old database. * @result The new database. */ -indexModule :: !Bool !String !Module !Library - !(String ModuleEntry -> ModuleEntry) !TemporaryDB !*World - -> *(!TemporaryDB, !*World) +indexModule :: !Bool !String !ModuleEntry !TemporaryDB !*World -> *(!TemporaryDB, !*World) :: LocationInModule = { dcl_line :: Maybe Int diff --git a/CloogleDBFactory.icl b/CloogleDBFactory.icl index 57aaaee..a80d2fa 100644 --- a/CloogleDBFactory.icl +++ b/CloogleDBFactory.icl @@ -26,7 +26,8 @@ import qualified Data.Set as S import Data.Tuple import System.Directory 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 @@ -71,7 +72,8 @@ from NGramIndex import :: NGramIndex, newNGramIndex, index from TypeTree import :: TypeTree, instance zero (TypeTree v), addType from CloogleDB import :: CloogleDB{..}, :: AnnotationKey, - :: Location(Location,Builtin,NoLocation), + :: Library, + :: Location(Builtin,NoLocation), :: CleanLangReportLocation, :: CloogleEntry(..), :: ModuleEntry{..}, @@ -84,7 +86,8 @@ from CloogleDB import :: DeriveEntry{..}, instance zero FunctionEntry, instance zero ModuleEntry, class getLocation, instance getLocation CloogleEntry, - instance == Location + instance == Location, + location from Cloogle import instance == FunctionKind from Doc import :: ModuleDoc, :: FunctionDoc{..}, :: ClassDoc, :: TypeDoc{..}, :: ConstructorDoc, :: ClassMemberDoc, :: Description, @@ -127,11 +130,11 @@ where instance < Location 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)) - < (Location _ _ _ _ _ _) _ + < ('CDB'.Location _ _ _ _ _ _) _ = True - < _ (Location _ _ _ _ _ _) + < _ ('CDB'.Location _ _ _ _ _ _) = False < (Builtin a _) (Builtin b _) = a < b @@ -140,6 +143,21 @@ where < _ _ = 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 extra tdb = { db = 'DB'.mapInPlace link $ newDB entries @@ -349,29 +367,38 @@ where [('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) -findModules ex root lib aux base w -| any ((<>) -1 o flip indexOf path) ex = ([], w) -#! (fps, w) = readDirectory path w +findModules :: !String !IndexItem !String !*World -> *(!['CDB'.ModuleEntry], !*World) +findModules root item base w +| match item.pattern_exclude path = ([], w) +#! (fps, w) = readDirectory fullpath w | isError fps = ([], w) #! (Ok fps) = fps -#! mods = map (\s -> let mod = basedot +++ s % (0, size s - 5) in - (lib, mod, aux)) $ filter included $ filter isIclModule fps -#! (moremodss,w) = mapSt (findModules ex root lib aux o ((+++) basedot)) (filter isDirectory fps) w -= (removeDupBy (\(l,m,_)->(l,m)) (mods ++ flatten moremodss), w) +#! mods = map makeEntry $ filter included $ filter isIclModule fps +#! (moremodss,w) = mapSt (findModules root item o ((+++) basedot)) (filter isDirectory fps) w += (removeDupBy (\m -> 'CDB'.getName m.me_loc) (mods ++ flatten moremodss), w) where basedot = if (base == "") "" (base +++ ".") - path = root lib replaceSubString "." {pathSeparator} base + path = replaceSubString "." {pathSeparator} base + fullpath = root item.IndexItem.name path + + () infixr 5 :: !FilePath !FilePath -> FilePath + () "" p = p + () p "" = p + () 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 - () infixr 5 :: !FilePath !FilePath -> FilePath - () "" p = p - () p "" = p - () p1 p2 = p1 p2 + modname = basedot +++ fn % (0, size fn - 5) 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 s = s % (size s - 4, size s - 1) == ".icl" @@ -383,14 +410,13 @@ where removeDupBy f [x:xs] = [x:removeDupBy f (filter ((<>) (f x) o f) xs)] removeDupBy _ [] = [] -indexModule :: !Bool !String !'CDB'.Module !'CDB'.Library - !(String 'CDB'.ModuleEntry -> 'CDB'.ModuleEntry) !TemporaryDB !*World +indexModule :: !Bool !String !'CDB'.ModuleEntry !TemporaryDB !*World -> *(!TemporaryDB, !*World) -indexModule include_locals root mod lib modf db w -#! (functions,macros,generics,typedefs,clss,insts,derivs,clsderivs,(modname,modentry,imports),w) - = findModuleContents include_locals (root lib mkdir mod) w +indexModule include_locals root mod db w +#! (functions,macros,generics,typedefs,clss,insts,derivs,clsderivs,(modname,_,imports),w) + = findModuleContents include_locals (root lib mkdir ('CDB'.getName mod.me_loc)) w #! 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 & temp_functions = @@ -403,17 +429,19 @@ indexModule include_locals root mod lib modf db w , temp_instances = [castLocThd3 modname insts:db.temp_instances] , temp_derivations = [map (appSnd (castLocThd3 modname)) derivs:db.temp_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) where + lib = fromJust ('CDB'.getLibrary mod.me_loc) + castLocThd3 :: String -> ([(a, b, LocationInModule)] -> [(a, b, 'CDB'.Location)]) castLocThd3 m = map (appThd3 (castLoc m)) castLocFrth m = map (\(a,b,c,l) -> (a,b,c,castLoc m l)) castLoc :: String LocationInModule -> 'CDB'.Location - castLoc m l = 'CDB'.Location lib m dclpath l.dcl_line l.icl_line $ fromMaybe "" l.name - dclpath = mkdir mod +++ ".dcl" + castLoc m l = location lib m dclpath l.dcl_line l.icl_line $ fromMaybe "" l.LocationInModule.name + dclpath = mkdir ('CDB'.getName mod.me_loc) +++ ".dcl" mkdir :: String -> String mkdir s = { if (c == '.') '/' c \\ c <-: s } @@ -463,7 +491,7 @@ findModuleContents include_locals path w , filter (not o isEmpty o snd) (map (appSnd (filter (hasDcl o thd3))) derivs) , filter (hasDcl o (\(_,_,_,x)->x)) clsderivs ) 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) where combine :: (a a -> Bool) (a a -> a) @@ -483,7 +511,7 @@ where (found,xs) -> let (foundys,ys`) = partition (eq y) ys in [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 = cmpLoc `on` fst @@ -521,9 +549,9 @@ where joinLoc :: LocationInModule LocationInModule -> LocationInModule joinLoc a b = - { dcl_line = a.dcl_line <|> b.dcl_line - , icl_line = a.icl_line <|> b.icl_line - , name = a.name <|> b.name + { dcl_line = a.dcl_line <|> b.dcl_line + , icl_line = a.icl_line <|> b.icl_line + , name = a.LocationInModule.name <|> b.LocationInModule.name } pd_module :: ![ParsedDefinition] -> ModuleEntry @@ -535,7 +563,7 @@ where pd_rewriterules :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.FunctionEntry, 'S'.Set String)] 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 trace_type_warning id { zero @@ -578,7 +606,7 @@ where pd_generics :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.FunctionEntry, 'S'.Set String)] 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 & fe_type=Just $ 'T'.toType gen_type , fe_generic_vars=Just $ map 'T'.toTypeVar gen_vars @@ -591,7 +619,7 @@ where pd_typespecs :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.FunctionEntry, 'S'.Set String)] pd_typespecs dcl defs st - = [( setLine dcl pos {zero & name=Just id_name} + = [( setLine dcl pos {LocationInModule | zero & name=Just id_name} , { zero & fe_type=Just $ 'T'.toType t , fe_priority = 'T'.toMaybePriority p @@ -618,7 +646,7 @@ where pd_classes dcl defs st = [ let 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 = { fe & fe_kind=if (isNothing $ lookup n macros) fe.fe_kind Macro @@ -627,8 +655,8 @@ where ((\d -> {FunctionDoc | d & vars=[]}) <$> findDoc hideIsUsedReturn id st) fe.fe_documentation } - members = [(f,updateRepresentation f et,ids) \\ ({name=Just f}, et, ids) <- typespecs] - in ( setLine dcl class_pos {zero & name=Just id_name} + members = [(f,updateRepresentation f et,ids) \\ ({LocationInModule | name=Just f}, et, ids) <- typespecs] + in ( setLine dcl class_pos {LocationInModule | zero & name=Just id_name} , 'CDB'.toClass NoLocation (map 'T'.toTypeVar class_args) @@ -655,7 +683,7 @@ where isSingleFunction :: [(LocationInModule, 'CDB'.FunctionEntry, a)] Ident -> Bool 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 hideFunctionOnClass (IllegalField "param") = False @@ -665,7 +693,7 @@ where pd_types :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.TypeDefEntry)] pd_types dcl defs st = [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{|*|} $ findDoc (const True) ptd.td_ident st ) \\ PD_Type ptd <- defs, td <- ['T'.toTypeDef ptd]] -- GitLab