WIP for function usages (clean-cloogle/cloogle.org#52)

AllIdents.dcl

+definition module AllIdents
+
+from StdClass import class Eq
+from StdList import isMember, removeDup
+from StdOverloaded import class ==
+
+from syntax import :: ParsedDefinition
+
+class AllIdents t
+where
+//	allIdents` :: t -> [String]
+//	allIdents :: t -> [String]
+//	allIdents x :== removeDup (allIdents` x)
+
+	definedIdents` :: t -> [String]
+	definedIdents :: t -> [String]
+	definedIdents x :== removeDup (definedIdents` x)
+
+	globalIdents` :: t -> [String]
+
+	globalIdents :: t -> [String] | AllIdents t
+	globalIdents x :== removeDup (globalIdents` x)
+
+instance AllIdents [t] | AllIdents t
+
+instance AllIdents ParsedDefinition

AllIdents.icl

+implementation module AllIdents
+
+from Data.List import concatMap
+
+import syntax
+
+instance AllIdents [t] | AllIdents t
+where
+	globalIdents` xs = concatMap globalIdents` xs
+	definedIdents` xs = concatMap definedIdents` xs
+
+instance AllIdents ParsedDefinition
+where
+	globalIdents` pd = case pd of
+		PD_Function _ id _ args rhs _ -> [i \\ i <- globalIdents rhs ++ globalIdents | not (isMember i [id.id_name:globalIdents args])]
+		PD_NodeDef _ e rhs -> [i \\ i <- globalIdents rhs | not (isMember i (globalIdents e))]
+		PD_Type ptd -> abort "AllIdents PD_Type\n"
+		PD_TypeSpec _ _ _ _ _ -> []
+		//PD_TypeSpec Position Ident Priority (Optional SymbolType) FunSpecials
+		//PD_Class ClassDef [ParsedDefinition]
+		//PD_Instance ParsedInstanceAndMembers
+		//PD_Instances [ParsedInstanceAndMembers]
+		//PD_Import [ParsedImport]
+		//PD_ImportedObjects [ImportedObject]
+		//PD_ForeignExport !Ident !{#Char} !Int !Bool /* if stdcall */
+		//PD_Generic GenericDef
+		//PD_GenericCase GenericCaseDef Ident
+		//PD_Derive [GenericCaseDef]
+		//PD_Documentation DocType String
+		//PD_Erroneous
+		_ -> abort "AllIdents ParsedDefinition\n"
+
+	definedIdents` pd = case pd of
+		PD_Function _ id _ _ _ _ -> [id.id_name]
+		PD_NodeDef _ e _ -> globalIdents` e
+		PD_TypeSpec _ _ _ _ _ -> []
+		// TODO
+
+instance AllIdents ParsedExpr
+where
+	globalIdents` pe = case pe of
+		PE_List pes -> globalIdents` pes
+		PE_Ident id -> [id.id_name]
+		PE_Basic _  -> []
+		PE_Bound e  -> []
+		PE_Lambda _ args rhs _ -> [i \\ i <- globalIdents rhs | not (isMember i (globalIdents args))]
+		PE_Tuple es -> globalIdents` es
+		PE_Record init _ fields -> globalIdents` init ++ globalIdents` [f.bind_src \\ f <- fields]
+		//(PE_Record !ParsedExpr !OptionalRecordName ![FieldAssignment]
+		PE_ArrayPattern _ -> abort "AllIdents PE_ArrayPattern"
+		//(PE_ArrayPattern ![ElemAssignment]
+		PE_UpdateComprehension _ _ _ _ -> abort "AllIdents PE_UpdateComprehension"
+		//(PE_UpdateComprehension !ParsedExpr !ParsedExpr !ParsedExpr ![Qualifier]
+		PE_ArrayDenot _ _ -> abort "AllIdents PE_ArrayDenot"
+		//(PE_ArrayDenot !ArrayKind ![ParsedExpr]
+		PE_Selection _ e s -> globalIdents` e ++ globalIdents` s
+		PE_Update _ _ _ -> abort "AllIdents PE_Update"
+		//(PE_Update !ParsedExpr [ParsedSelection] ParsedExpr
+		PE_Case _ pe alts -> globalIdents` pe ++ globalIdents` alts
+		PE_If _ b t e -> globalIdents` [b,t,e]
+		//(PE_If !Ident !ParsedExpr !ParsedExpr !ParsedExpr
+		PE_Let locals e -> globalIdents` locals ++ globalIdents` e
+		PE_ListCompr _ _ e qs -> [i \\ i <- globalIdents e ++ globalIdents qs | not (isMember i (definedIdents qs))]
+		PE_ArrayCompr _ e qs -> [i \\ i <- globalIdents e ++ globalIdents qs | not (isMember i (definedIdents qs))]
+		//(PE_ArrayCompr !ArrayKind !ParsedExpr ![Qualifier]
+		PE_Sequ s -> globalIdents` s
+		PE_WildCard -> []
+		PE_Matches _ _ _ _ -> abort "AllIdents PE_Matches"
+		//(PE_Matches !Ident /*expr*/!ParsedExpr /*pattern*/!ParsedExpr !Position
+		//(PE_QualifiedIdent !Ident !String
+		PE_ABC_Code _ _ -> []
+		PE_Any_Code _ _ _ -> []
+		//(PE_DynamicPattern !ParsedExpr !DynamicType
+		//(PE_Dynamic !ParsedExpr !(Optional DynamicType)
+		//(PE_Generic !Ident !TypeKind	/* AA: For generics, kind indexed identifier */
+		//(PE_TypeSignature !ArrayKind !ParsedExpr
+		PE_Empty -> []
+		_ -> abort "AllIdents ParsedExpr\n"
+
+	definedIdents` pe = case pe of
+		(PE_List pes) -> []
+		(PE_Ident id) -> []
+		(PE_Basic _)  -> []
+		(PE_Bound e)  -> [e.bind_dst.id_name:globalIdents` e.bind_src]
+		(PE_Lambda _ _ _ _) -> []
+		(PE_Tuple _) -> []
+		(PE_Record _ _ _) -> []
+		(PE_ArrayPattern _) -> abort "AllIdents PE_ArrayPattern"
+		//(PE_ArrayPattern ![ElemAssignment]
+		(PE_UpdateComprehension _ _ _ _) -> abort "AllIdents PE_UpdateComprehension"
+		//(PE_UpdateComprehension !ParsedExpr !ParsedExpr !ParsedExpr ![Qualifier]
+		(PE_ArrayDenot _ _) -> abort "AllIdents PE_ArrayDenot"
+		//(PE_ArrayDenot !ArrayKind ![ParsedExpr]
+		(PE_Selection _ _ _) -> abort "AllIdents PE_Selection"
+		//(PE_Selection !ParsedSelectorKind !ParsedExpr ![ParsedSelection]
+		(PE_Update _ _ _) -> abort "AllIdents PE_Update"
+		//(PE_Update !ParsedExpr [ParsedSelection] ParsedExpr
+		(PE_Case _ pe alts) -> globalIdents` pe ++ globalIdents` alts
+		(PE_If _ b t e) -> globalIdents` [b,t,e]
+		//(PE_If !Ident !ParsedExpr !ParsedExpr !ParsedExpr
+		(PE_Let locals e) -> globalIdents` locals ++ globalIdents` e
+		(PE_ListCompr _ _ e qs) -> [i \\ i <- globalIdents e | not (isMember i (globalIdents qs))]
+		//(PE_ArrayCompr !ArrayKind !ParsedExpr ![Qualifier]
+		//(PE_Sequ Sequence
+		PE_WildCard -> []
+		//(PE_Matches !Ident /*expr*/!ParsedExpr /*pattern*/!ParsedExpr !Position
+		//(PE_QualifiedIdent !Ident !String
+		//(PE_ABC_Code ![String] !Bool
+		//(PE_Any_Code !(CodeBinding Ident) !(CodeBinding Ident) ![String]
+		//(PE_DynamicPattern !ParsedExpr !DynamicType
+		//(PE_Dynamic !ParsedExpr !(Optional DynamicType)
+		//(PE_Generic !Ident !TypeKind	/* AA: For generics, kind indexed identifier */
+		//(PE_TypeSignature !ArrayKind !ParsedExpr
+		PE_Empty -> []
+		_ -> abort "AllIdents ParsedExpr\n"
+
+instance AllIdents (Optional a) | AllIdents a
+where
+	globalIdents` No = []
+	globalIdents` (Yes x) = globalIdents` x
+
+	definedIdents` No = []
+	definedIdents` (Yes x) = definedIdents` x
+
+instance AllIdents Rhs
+where
+	globalIdents` rhs = [i \\ i <- globalIdents rhs.rhs_alts ++ globalIdents rhs.rhs_locals | not (isMember i (definedIdents rhs.rhs_locals))]
+	definedIdents` _ = []
+
+instance AllIdents LocalDefs
+where
+	globalIdents` (LocalParsedDefs defs) = globalIdents` defs
+	globalIdents` _ = abort "AllIdents LocalDefs\n"
+
+	definedIdents` (LocalParsedDefs defs) = definedIdents` defs
+	definedIdents` _ = abort "definedIdents` LocalDefs\n"
+
+instance AllIdents OptGuardedAlts
+where
+	globalIdents` (UnGuardedExpr e) = globalIdents` e
+	globalIdents` (GuardedAlts es oth) = globalIdents` es ++ globalIdents` oth
+
+	definedIdents` _ = []
+
+instance AllIdents ExprWithLocalDefs
+where
+	globalIdents` e = [i \\ i <- globalIdents e.ewl_expr | not (isMember i (globalIdents e.ewl_locals))]
+	definedIdents` _ = []
+		// NOTE ewl_nodes?
+
+instance AllIdents GuardedExpr
+where
+	globalIdents` e = globalIdents` e.alt_guard ++ globalIdents` e.alt_expr
+	definedIdents` _ = []
+		// NOTE alt_nodes?
+
+instance AllIdents CaseAlt
+where
+	globalIdents` a = [i \\ i <- globalIdents a.calt_rhs | not (isMember i (globalIdents a.calt_pattern))]
+	definedIdents` _ = []
+
+instance AllIdents Qualifier
+where
+	globalIdents` q = globalIdents` q.qual_generators ++ globalIdents` q.qual_let_defs ++ globalIdents` q.qual_filter
+	definedIdents` q = definedIdents` q.qual_generators
+
+instance AllIdents Generator
+where
+	globalIdents` g = globalIdents` g.gen_expr
+	definedIdents` g = definedIdents` g.gen_pattern
+
+instance AllIdents Sequence
+where
+	globalIdents` s = case s of
+		SQ_FromThen   _ a b   -> globalIdents` [a,b]
+		SQ_FromThenTo _ a b c -> globalIdents` [a,b]
+		SQ_From       _ a     -> globalIdents` a
+		SQ_FromTo     _ a b   -> globalIdents` [a,b]
+	definedIdents` _ = []
+
+instance AllIdents ParsedSelection
+where
+	globalIdents` ps = case ps of
+		PS_Record id _           -> [id.id_name]
+		PS_QualifiedRecord _ s _ -> [s]
+		PS_Array e               -> globalIdents` e
+		PS_Erroneous             -> []
+	definedIdents` _ = []
+
+import StdMisc

CloogleDB.dcl

@@ -102,6 +102,7 @@ derive JSONDecode CloogleEntry
 	  , fe_documentation  :: !Maybe FunctionDoc //* Documentation on this entry
 	  , fe_class          :: !Maybe Index    //* The class, for class members
 	  , fe_derivations    :: !Maybe [Index]  //* The DerivaionEntries
+	  , fe_usages         :: ![Index]        //* FunctionEntries where the implementation uses this function
 	  }
 
 /**

CloogleDB.icl

@@ -98,6 +98,7 @@ where
 		, fe_documentation  = Nothing
 		, fe_class          = Nothing
 		, fe_derivations    = Nothing
+		, fe_usages         = []
 		}
 
 instance zero ModuleEntry
@@ -456,9 +457,11 @@ filterUsages names wrap=:{db,name_map}
 # db = 'DB'.searchIndices Intersect   (sort [(i,[(ExactResult,1)]) \\ is <- idxss, i <- is]) db
 // For all lists of entries, the corresponding usages
 # (entriess,db) = mapSt 'DB'.getIndices idxss db
-# usagess = map (foldr1 mergeUnion o map \e -> getUsages e.value) entriess
+# usagess = map (foldr mergeUnion [] o map \e -> getUsages e.value) entriess
 // AND all usages together
-# usages = foldr1 mergeIntersect usagess
+# usages = case usagess of
+	[] -> []
+	us -> foldr1 mergeIntersect us
 # db = 'DB'.searchIndices AddExcluded [(u,[]) \\ u <- usages] db
 = {wrap & db=db}
 where
@@ -466,6 +469,7 @@ where
 	getUsages (TypeDefEntry tde) = tde.tde_usages
 	getUsages (ClassEntry ce)    = ce.ce_usages
 	getUsages (ModuleEntry me)   = me.me_usages
+	getUsages (FunctionEntry fe) = fe.fe_usages
 	getUsages _                  = []
 
 	// Efficient union on sorted lists

CloogleDBFactory.dcl

@@ -69,11 +69,11 @@ indexModule :: !Bool !String !Module !Library
  *   - The module
  */
 findModuleContents :: !Bool !String !*World
-	-> *( ![(LocationInModule, FunctionEntry)]
-	    , ![(LocationInModule, FunctionEntry)]
-	    , ![(LocationInModule, FunctionEntry)]
+	-> *( ![(LocationInModule, FunctionEntry, [String])]
+	    , ![(LocationInModule, FunctionEntry, [String])]
+	    , ![(LocationInModule, FunctionEntry, [String])]
 	    , ![(LocationInModule, TypeDefEntry)]
-	    , ![(LocationInModule, ClassEntry, [(String, FunctionEntry)])]
+	    , ![(LocationInModule, ClassEntry, [(String, FunctionEntry, [String])])]
 	    , ![(Name, [(Type, String)], LocationInModule)]
 	    , ![(Name, [(Type, String, LocationInModule)])]
 	    , ![(Name, Type, String, LocationInModule)]