Skip to content

GitLab

Verified Commit 7bd21048 authored by Camil Staps's avatar Camil Staps
Browse files

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

parent ed7e5eed
Hide whitespace changes
Inline Side-by-side
Showing with 288 additions and 52 deletions
AllIdents.dcl 0 → 100644
View file @ 7bd21048
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 0 → 100644
View file @ 7bd21048
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
View file @ 7bd21048
......@@ -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
View file @ 7bd21048
......@@ -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
View file @ 7bd21048
......@@ -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)]
......
CloogleDBFactory.icl
View file @ 7bd21048
......@@ -95,16 +95,18 @@ from Doc import :: ModuleDoc, :: FunctionDoc{..}, :: ClassDoc, :: TypeDoc{..},
class docFields(..), instance docFields TypeDoc,
traceParseError, traceParseWarnings,
constructorToFunctionDoc, functionToClassMemberDoc, addClassMemberDoc
import AllIdents
:: TemporaryDB
= { temp_functions :: ![['CDB'.FunctionEntry]]
, temp_classes :: ![[('CDB'.ClassEntry, [(String, 'CDB'.FunctionEntry)])]]
= { temp_functions :: ![[('CDB'.FunctionEntry, [String])]]
, temp_classes :: ![[('CDB'.ClassEntry, [(String, 'CDB'.FunctionEntry, [String])])]]
, temp_instances :: ![[(!'CDB'.Name, ![(!'CDB'.Type, !String)], !'CDB'.Location)]]
, temp_types :: ![['CDB'.TypeDefEntry]]
, temp_derivations :: ![[(!'CDB'.Name, ![(!'CDB'.Type, !String, !'CDB'.Location)])]]
, temp_class_derivations :: ![[(!'CDB'.Name, !'CDB'.Type, !String, !'CDB'.Location)]]
, temp_modules :: ![(ModuleEntry, [String])]
}
// TODO function usages in instances/derivations
newTemporaryDB :: TemporaryDB
newTemporaryDB
......@@ -182,12 +184,20 @@ where
| name == 'CDB'.getName ce.ce_loc = []
| otherwise = classContext ce
context _ = []
link _ (FunctionEntry fe=:{fe_derivations=Just _}) = FunctionEntry
link _ (FunctionEntry fe) = FunctionEntry
{ fe
& fe_derivations=Just $ idxfilter \e -> case e of
DeriveEntry de -> de.de_generic == 'CDB'.getName fe.fe_loc
_ -> False
& fe_derivations=case fe.fe_derivations of
Nothing -> Nothing
Just _ -> Just $ idxfilter \e -> case e of
DeriveEntry de -> de.de_generic == 'CDB'.getName fe.fe_loc
_ -> False
, fe_usages=idxfilter` \e -> case e of
FunctionEntry fe -> case find (\(fun,_) -> fun.fe_loc == fe.fe_loc) function_entries of
Nothing -> False
Just (_,imps) -> isMember name imps
_ -> False
}
where name = 'CDB'.getName fe.fe_loc
link _ (ModuleEntry me) = ModuleEntry
{ me
& me_usages=idxfilter` \e -> case e of
......@@ -196,24 +206,14 @@ where
Just (_,imps) -> isMember name imps
_ -> False
}
where
name = 'CDB'.getName me.me_loc
where name = 'CDB'.getName me.me_loc
link _ e = e
entries` = map Right (
extra ++
[FunctionEntry fun \\ funs <- tdb.temp_functions, fun <- funs] ++
[TypeDefEntry tde \\ tds <- tdb.temp_types, tde <- tds] ++
[ModuleEntry mod \\ (mod,_) <- tdb.temp_modules] ++
map ClassEntry classes ++
[FunctionEntry
{ fun
& fe_kind=case fun.fe_kind of Function -> ClassMember; Macro -> ClassMacro
, fe_loc='CDB'.setName fname cls.ce_loc
, fe_class=Just $ idxhd \ce -> case ce of
ClassEntry ce -> ce.ce_loc == cls.ce_loc
_ -> False
}
\\ clss <- tdb.temp_classes, (cls,funs) <- clss, (fname,fun) <- funs] ++
map (FunctionEntry o fst) function_entries ++
// Normal instances
[InstanceEntry {ie_class=cls,ie_types=types,ie_locations=map thd3 is}
\\ is=:[(cls,types,_):_] <- groupBy instanceEq
......@@ -262,6 +262,15 @@ where
instanceEq :: (String, [('CDB'.Type, a)], b) (String, [('CDB'.Type, a)], b) -> Bool
instanceEq (s, ts, _) (s2, ts2, _) = s == s2 && all (uncurry (isomorphic_to)) (zip2 (map fst ts) (map fst ts2))
function_entries = flatten tdb.temp_functions ++ [(
{ fun
& fe_kind=case fun.fe_kind of Function -> ClassMember; Macro -> ClassMacro
, fe_loc='CDB'.setName fname cls.ce_loc
, fe_class=Just $ idxhd \ce -> case ce of
ClassEntry ce -> ce.ce_loc == cls.ce_loc
_ -> False
}, ids) \\ clss <- tdb.temp_classes, (cls,funs) <- clss, (fname,fun,ids) <- funs]
entridxs = zip2 [Index i \\ i <- [0..]] entries
idxfilter f = [idx \\ (idx,e) <- entridxs | f e]
idxhd = hd o idxfilter
......@@ -352,8 +361,8 @@ indexModule include_locals root mod lib modf db w
#! db =
{ db
& temp_functions =
[ [{f & fe_loc=castLoc modname loc} \\ (loc,f) <- functions ++ macros ++ generics]
, [f \\ td <- typedefs, f <- constructor_functions td ++ record_functions td]
[ [({f & fe_loc=castLoc modname loc},idents) \\ (loc,f,idents) <- functions ++ macros ++ generics]
, [(f, []) \\ td <- typedefs, f <- constructor_functions td ++ record_functions td]
: db.temp_functions
]
, temp_classes = [[({ce & ce_loc=castLoc modname loc}, fs) \\ (loc,ce,fs) <- clss]:db.temp_classes]
......@@ -380,11 +389,11 @@ instance zero LocationInModule
where zero = {dcl_line=Nothing, icl_line=Nothing, name=Nothing}
findModuleContents :: !Bool !String !*World
-> *( ![(LocationInModule, 'CDB'.FunctionEntry)]
, ![(LocationInModule, 'CDB'.FunctionEntry)]
, ![(LocationInModule, 'CDB'.FunctionEntry)]
-> *( ![(LocationInModule, 'CDB'.FunctionEntry, [String])]
, ![(LocationInModule, 'CDB'.FunctionEntry, [String])]
, ![(LocationInModule, 'CDB'.FunctionEntry, [String])]
, ![(LocationInModule, 'CDB'.TypeDefEntry)]
, ![(LocationInModule, 'CDB'.ClassEntry, [(String, 'CDB'.FunctionEntry)])]
, ![(LocationInModule, 'CDB'.ClassEntry, [(String, 'CDB'.FunctionEntry, [String])])]
, ![('CDB'.Name, [('CDB'.Type, String)], LocationInModule)]
, ![('CDB'.Name, [('CDB'.Type, String, LocationInModule)])]
, ![('CDB'.Name, 'CDB'.Type, String, LocationInModule)]
......@@ -400,28 +409,28 @@ findModuleContents include_locals path w
#! icl = case icl of Left _ -> []; Right icl -> icl.mod_defs
#! imports = [i.import_module.id_name \\ PD_Import is <- icl, i <- is]
#! contents=:(functions,rules,generics,typedefs,clss,insts,derivs,clsderivs) =
( combine cmpLocFst joinLocFst pd_typespecs dcl dcl_symbols icl icl_symbols
, combine cmpLocFst joinLocFst pd_rewriterules dcl dcl_symbols icl icl_symbols
, combine cmpLocFst joinLocFst pd_generics dcl dcl_symbols icl icl_symbols
, combine cmpLocFst joinTypeDefs pd_types dcl dcl_symbols icl icl_symbols
, combine cmpLocFst3 joinLocFst3 pd_classes dcl dcl_symbols icl icl_symbols
, combine cmpInsts joinInsts pd_instances dcl dcl_symbols icl icl_symbols
( combine cmpLocFst3 joinLocFstIds pd_typespecs dcl dcl_symbols icl icl_symbols
, combine cmpLocFst3 joinLocFstIds pd_rewriterules dcl dcl_symbols icl icl_symbols
, combine cmpLocFst3 joinLocFstIds pd_generics dcl dcl_symbols icl icl_symbols
, combine cmpLocFst joinTypeDefs pd_types dcl dcl_symbols icl icl_symbols
, combine cmpLocFst3 joinLocFst3 pd_classes dcl dcl_symbols icl icl_symbols
, combine cmpInsts joinInsts pd_instances dcl dcl_symbols icl icl_symbols
, combineDerivs (pd_derivations True dcl) (pd_derivations False icl)
, combine cmpClsDeriv joinClsDeriv pd_class_derivations dcl dcl_symbols icl icl_symbols
)
#! (functions,rules,generics,typedefs,clss,insts,derivs,clsderivs) =
if include_locals
contents
( filter (hasDcl o fst) functions
, filter (hasDcl o fst) rules
, filter (hasDcl o fst) generics
( filter (hasDcl o fst3) functions
, filter (hasDcl o fst3) rules
, filter (hasDcl o fst3) generics
, filter (hasDcl o fst) typedefs
, filter (hasDcl o fst3) clss
, filter (hasDcl o thd3) insts
, 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.name == fromJust r.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)
......@@ -455,6 +464,9 @@ where
joinLocFst3 :: (LocationInModule, a, b) (LocationInModule, c, d) -> (LocationInModule, a, b)
joinLocFst3 (l1,a,b) (l2,_,_) = (joinLoc l1 l2, a, b)
joinLocFstIds :: (LocationInModule, a, [String]) (LocationInModule, b, [String]) -> (LocationInModule, a, [String])
joinLocFstIds (l1,a,idsa) (l2,_,idsb) = (joinLoc l1 l2, a, removeDup (idsa ++ idsb))
joinTypeDefs :: (LocationInModule, 'CDB'.TypeDefEntry) (LocationInModule, 'CDB'.TypeDefEntry) -> (LocationInModule, 'CDB'.TypeDefEntry)
joinTypeDefs (a,t) (b,u) = (joinLoc a b, 'CDB'.mergeTypeDefEntries t u)
......@@ -488,7 +500,7 @@ where
}
pd_module _ = zero
pd_rewriterules :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.FunctionEntry)]
pd_rewriterules :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.FunctionEntry, [String])]
pd_rewriterules dcl defs st
= [( setLine dcl pos {zero & name=Just id.id_name}
, let doc = findDoc hideIsUsedReturn id st in
......@@ -500,6 +512,7 @@ where
, fe_priority=findPrio id >>= 'T'.toMaybePriority
, fe_documentation=doc
}
, globalIdents pd
) \\ pd=:(PD_Function pos id isinfix args rhs _) <- defs]
where
priostring :: Ident ParsedDefinition -> String
......@@ -530,7 +543,7 @@ where
\\ gcdefs <- [ds \\ PD_Derive ds <- defs] ++ [[d] \\ PD_GenericCase d _ <- defs]
, {gc_type,gc_pos,gc_gcf=GCF id _} <- gcdefs]
pd_generics :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.FunctionEntry)]
pd_generics :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.FunctionEntry, [String])]
pd_generics dcl defs st
= [( setLine dcl gen_pos {zero & name=Just id_name}
, { zero
......@@ -540,9 +553,10 @@ where
, fe_documentation=findDoc hideIsUsedReturn id st
, fe_derivations=Just []
}
, []
) \\ gen=:(PD_Generic {gen_ident=id=:{id_name},gen_pos,gen_type,gen_vars}) <- defs]
pd_typespecs :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.FunctionEntry)]
pd_typespecs :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.FunctionEntry, [String])]
pd_typespecs dcl defs st
= [( setLine dcl pos {zero & name=Just id_name}
, { zero
......@@ -551,6 +565,7 @@ where
, fe_representation = Just $ cpp ts
, fe_documentation = findDoc hideIsUsedReturn id st
}
, globalIdents [pd \\ pd=:(PD_Function _ id _ _ _ _) <- defs | id.id_name == id_name] // TODO check
) \\ ts=:(PD_TypeSpec pos id=:{id_name} p (Yes t) funspecs) <- defs]
pd_class_derivations :: !Bool ![ParsedDefinition] SymbolTable -> [('CDB'.Name, 'CDB'.Type, String, LocationInModule)]
......@@ -566,25 +581,25 @@ where
[(i.pi_ident.id_name, i.pi_types, i.pi_pos) \\ PD_Instance {pim_pi=i} <- defs]
++ [(i.pi_ident.id_name, i.pi_types, i.pi_pos) \\ PD_Instances pis <- defs, {pim_pi=i} <- pis]
pd_classes :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.ClassEntry, [(String, 'CDB'.FunctionEntry)])]
pd_classes :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.ClassEntry, [(String, 'CDB'.FunctionEntry, [String])])]
pd_classes dcl defs st
= [ let
typespecs = pd_typespecs True clsdefs st
macros = [(n,r) \\ ({name=Just n},{fe_representation=Just r}) <- pd_rewriterules dcl clsdefs st]
macros = [(n,(r,ids)) \\ ({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
, fe_representation=lookup n macros <|> fe.fe_representation
, fe_representation=(fst <$> lookup n macros) <|> fe.fe_representation
, fe_documentation=if (isSingleFunction typespecs id)
((\d -> {FunctionDoc | d & vars=[]}) <$> findDoc hideIsUsedReturn id st)
fe.fe_documentation
}
members = [(f,updateRepresentation f et) \\ ({name=Just f}, et) <- typespecs]
members = [(f,updateRepresentation f et,ids) \\ ({name=Just f}, et, ids) <- typespecs]
in ( setLine dcl class_pos {zero & name=Just id_name}
, 'CDB'.toClass
NoLocation
(map 'T'.toTypeVar class_args)
(all (\(_,fe) -> fe.fe_kind == Macro) members)
(all (\(_,fe,_) -> fe.fe_kind == Macro) members)
(flatten $ map 'T'.toTypeContext class_context)
(parseClassDoc typespecs id st)
, members
......@@ -596,18 +611,18 @@ where
// the class documentation as the function's documentation. This is the
// case for classes like `class zero a :: a`, which do not have a where
// clause and hence no other place for the function's documentation.
parseClassDoc :: [(LocationInModule, 'CDB'.FunctionEntry)] Ident SymbolTable -> Maybe ClassDoc
parseClassDoc :: [(LocationInModule, 'CDB'.FunctionEntry, a)] Ident SymbolTable -> Maybe ClassDoc
parseClassDoc members id st
| isSingleFunction members id = flip addClassMemberDoc
(functionToClassMemberDoc <$> findDoc hideIsUsedReturn id st)
<$> findDoc hideFunctionOnClass id st
| otherwise = flip (foldl addClassMemberDoc)
[functionToClassMemberDoc <$> fe.fe_documentation \\ (_,fe) <- members]
[functionToClassMemberDoc <$> fe.fe_documentation \\ (_,fe,_) <- members]
<$> findDoc hideIsUsedReturn id st
isSingleFunction :: [(LocationInModule, 'CDB'.FunctionEntry)] Ident -> Bool
isSingleFunction :: [(LocationInModule, 'CDB'.FunctionEntry, a)] Ident -> Bool
isSingleFunction members id = length members == 1
&& fromJust (fst $ hd members).name == id.id_name
&& fromJust (fst3 $ hd members).name == id.id_name
// Hide warnings about @result and @param on single function classes
hideFunctionOnClass (IllegalField "param") = False
......
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