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

Implement function usages

parent 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
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
Subproject commit 1a9e842bb4c58ec4ff270b843d878f3fce8e0c22
Subproject commit 25b5f828ddb77a10482ba69b5f35f34c45779cc8
Subproject commit c68334f3df6257e0a17259974a0ec25278981d0c
Subproject commit d052c6fb6fcbff6316f913892f310ce476e5bf0b
......@@ -4,6 +4,8 @@ definition module CloogleDBFactory
* Functions to populate a database using the Clean compiler frontend
*/
from Data.Set import :: Set
import CloogleDB
:: TemporaryDB
......@@ -69,15 +71,15 @@ indexModule :: !Bool !String !Module !Library
* - The module
*/
findModuleContents :: !Bool !String !*World
-> *( ![(LocationInModule, FunctionEntry, [String])]
, ![(LocationInModule, FunctionEntry, [String])]
, ![(LocationInModule, FunctionEntry, [String])]
-> *( ![(LocationInModule, FunctionEntry, Set String)]
, ![(LocationInModule, FunctionEntry, Set String)]
, ![(LocationInModule, FunctionEntry, Set String)]
, ![(LocationInModule, TypeDefEntry)]
, ![(LocationInModule, ClassEntry, [(String, FunctionEntry, [String])])]
, ![(LocationInModule, ClassEntry, [(String, FunctionEntry, Set String)])]
, ![(Name, [(Type, String)], LocationInModule)]
, ![(Name, [(Type, String, LocationInModule)])]
, ![(Name, Type, String, LocationInModule)]
, !(Name, ModuleEntry, [String])
, !(Name, ModuleEntry, Set String)
, !*World
)
......
......@@ -23,10 +23,11 @@ import Data.List
from Data.Map import :: Map
import qualified Data.Map as M
import Data.Maybe
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), instance Text String, <+
import CleanPrettyPrint
......@@ -95,16 +96,16 @@ from Doc import :: ModuleDoc, :: FunctionDoc{..}, :: ClassDoc, :: TypeDoc{..},
class docFields(..), instance docFields TypeDoc,
traceParseError, traceParseWarnings,
constructorToFunctionDoc, functionToClassMemberDoc, addClassMemberDoc
import AllIdents
import Idents
:: TemporaryDB
= { temp_functions :: ![[('CDB'.FunctionEntry, [String])]]
, temp_classes :: ![[('CDB'.ClassEntry, [(String, 'CDB'.FunctionEntry, [String])])]]
= { temp_functions :: ![[('CDB'.FunctionEntry, 'S'.Set String)]]
, temp_classes :: ![[('CDB'.ClassEntry, [(String, 'CDB'.FunctionEntry, 'S'.Set 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])]
, temp_modules :: ![(ModuleEntry, 'S'.Set String)]
}
// TODO function usages in instances/derivations
......@@ -119,9 +120,30 @@ newTemporaryDB
, temp_modules = []
}
instance < (Maybe a) | < a
where
< (Just x) (Just y) = x < y
< (Just _) Nothing = True
< _ _ = False
instance < Location
where
< (Location l1 m1 _ d1 i1 n1) (Location l2 m2 _ d2 i2 n2)
= ((l1,m1,n1),(d1,i1)) < ((l2,m2,n2), (d2,i2))
< (Location _ _ _ _ _ _) _
= True
< _ (Location _ _ _ _ _ _)
= False
< (Builtin a _) (Builtin b _)
= a < b
< (Builtin _ _) _
= True
< _ _
= False
finaliseDB :: ![CloogleEntry] !TemporaryDB -> *'CDB'.CloogleDB
finaliseDB extra tdb =
{ db = newDB entries
{ db = 'DB'.mapInPlace link $ newDB entries
, name_ngrams = foldr (uncurry index) (newNGramIndex 3 True)
[('CDB'.getName loc, i) \\ (i,e) <- entridxs, Just loc <- ['CDB'.getLocation e]]
, name_map = foldr (\(name,i) -> flip 'M'.alter name \is -> case is of
......@@ -148,10 +170,9 @@ finaliseDB extra tdb =
, always_unique = always_unique
}
where
entries = [link i e \\ Right e <- filter (\e -> e=:(Right _)) entries` & i <- [0..]]
where
link :: Int CloogleEntry -> CloogleEntry
link _ (TypeDefEntry tde) = TypeDefEntry
link :: !Int !CloogleEntry -> CloogleEntry
link i e = trace_n ("Linking #" <+ i <+ fromMaybe "" ((\loc -> ": " <+ 'CDB'.getName loc) <$> 'CDB'.getLocation e)) case e of
TypeDefEntry tde -> TypeDefEntry
{ tde
& tde_instances=idxfilter \e -> case e of
InstanceEntry ie -> or [t == name \\ 'T'.Type t _ <- concatMap ('T'.subtypes o fst) ie.ie_types]
......@@ -164,7 +185,7 @@ where
_ -> False
}
with name = 'T'.td_name $ 'CDB'.getTypeDef tde
link i (ClassEntry ce) = ClassEntry
ClassEntry ce -> ClassEntry
{ ce
& ce_instances=idxfilter \e -> case e of
InstanceEntry ie -> ie.ie_class == name
......@@ -172,7 +193,7 @@ where
, ce_members=idxfilter \e -> case e of
FunctionEntry fe -> fe.fe_class == Just (Index i)
_ -> False
, ce_usages=idxfilter` \e -> or [cls == name \\ 'T'.Instance cls _ <- context e]
, ce_usages=idxfilter \e -> or [cls == name \\ 'T'.Instance cls _ <- context e]
}
with
name = 'CDB'.getName ce.ce_loc
......@@ -184,30 +205,28 @@ where
| name == 'CDB'.getName ce.ce_loc = []
| otherwise = classContext ce
context _ = []
link _ (FunctionEntry fe) = FunctionEntry
FunctionEntry fe -> FunctionEntry
{ fe
& 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
DeriveEntry de -> de.de_generic == name
_ -> 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
, fe_usages=fromMaybe [] ('M'.get ('CDB'.getName fe.fe_loc) global_functions_map)
}
where name = 'CDB'.getName fe.fe_loc
link _ (ModuleEntry me) = ModuleEntry
with name = 'CDB'.getName fe.fe_loc
ModuleEntry me -> ModuleEntry
{ me
& me_usages=idxfilter` \e -> case e of
& me_usages=idxfilter \e -> case e of
ModuleEntry me -> case find (\(mod,_) -> mod.me_loc == me.me_loc) tdb.temp_modules of
Nothing -> False
Just (_,imps) -> isMember name imps
Just (_,imps) -> 'S'.member name imps
_ -> False
}
where name = 'CDB'.getName me.me_loc
link _ e = e
with name = 'CDB'.getName me.me_loc
e -> e
entries = [e \\ Right e <- entries`]
entries` = map Right (
extra ++
[TypeDefEntry tde \\ tds <- tdb.temp_types, tde <- tds] ++
......@@ -262,6 +281,17 @@ 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))
global_functions_map = 'M'.fromList
$ map (\gidxs=:[(g,_):_] -> (g,map snd gidxs))
$ groupBy ((==) `on` fst)
$ sortBy ((<) `on` fst)
$ flatten
[[(g,idx) \\ g <- removeDup ('S'.toList globs)] // TODO remove removeDup when Data.Set difference is fixed
\\ idx <- fidxs
& (fe,globs) <- [(fe, 'S'.newSet) \\ FunctionEntry fe <- extra] ++ function_entries]
where
fidxs = [idx \\ (idx,FunctionEntry _) <- entridxs]
function_entries = flatten tdb.temp_functions ++ [(
{ fun
& fe_kind=case fun.fe_kind of Function -> ClassMember; Macro -> ClassMacro
......@@ -275,9 +305,6 @@ where
idxfilter f = [idx \\ (idx,e) <- entridxs | f e]
idxhd = hd o idxfilter
// WARNING: indexes may be wrong after meta-instances due to the use of Left
idxfilter` f = [idx \\ (idx,Right e) <- zip2 [Index i \\ i <- [0..]] entries` | f e]
coreidxs = idxfilter \e -> case 'CDB'.getLocation e of
Nothing -> False
Just l -> case ('CDB'.getLibrary l, 'CDB'.getModule l) of
......@@ -362,7 +389,7 @@ indexModule include_locals root mod lib modf db w
{ db
& temp_functions =
[ [({f & fe_loc=castLoc modname loc},idents) \\ (loc,f,idents) <- functions ++ macros ++ generics]
, [(f, []) \\ td <- typedefs, f <- constructor_functions td ++ record_functions td]
, [(f, 'S'.newSet) \\ 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]
......@@ -389,15 +416,15 @@ instance zero LocationInModule
where zero = {dcl_line=Nothing, icl_line=Nothing, name=Nothing}
findModuleContents :: !Bool !String !*World
-> *( ![(LocationInModule, 'CDB'.FunctionEntry, [String])]
, ![(LocationInModule, 'CDB'.FunctionEntry, [String])]
, ![(LocationInModule, 'CDB'.FunctionEntry, [String])]
-> *( ![(LocationInModule, 'CDB'.FunctionEntry, 'S'.Set String)]
, ![(LocationInModule, 'CDB'.FunctionEntry, 'S'.Set String)]
, ![(LocationInModule, 'CDB'.FunctionEntry, 'S'.Set String)]
, ![(LocationInModule, 'CDB'.TypeDefEntry)]
, ![(LocationInModule, 'CDB'.ClassEntry, [(String, 'CDB'.FunctionEntry, [String])])]
, ![(LocationInModule, 'CDB'.ClassEntry, [(String, 'CDB'.FunctionEntry, 'S'.Set String)])]
, ![('CDB'.Name, [('CDB'.Type, String)], LocationInModule)]
, ![('CDB'.Name, [('CDB'.Type, String, LocationInModule)])]
, ![('CDB'.Name, 'CDB'.Type, String, LocationInModule)]
, !('CDB'.Name, 'CDB'.ModuleEntry, [String])
, !('CDB'.Name, 'CDB'.ModuleEntry, 'S'.Set String)
, !*World
)
findModuleContents include_locals path w
......@@ -407,7 +434,7 @@ findModuleContents include_locals path w
Right dcl -> (dcl.mod_defs, dcl.mod_ident.id_name)
#! (icl,icl_symbols,w) = readModule True w
#! icl = case icl of Left _ -> []; Right icl -> icl.mod_defs
#! imports = [i.import_module.id_name \\ PD_Import is <- icl, i <- is]
#! imports = 'S'.fromList [i.import_module.id_name \\ PD_Import is <- icl, i <- is]
#! contents=:(functions,rules,generics,typedefs,clss,insts,derivs,clsderivs) =
( combine cmpLocFst3 joinLocFstIds pd_typespecs dcl dcl_symbols icl icl_symbols
, combine cmpLocFst3 joinLocFstIds pd_rewriterules dcl dcl_symbols icl icl_symbols
......@@ -464,8 +491,8 @@ 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))
joinLocFstIds :: (LocationInModule, a, 'S'.Set String) (LocationInModule, b, 'S'.Set String) -> (LocationInModule, a, 'S'.Set String)
joinLocFstIds (l1,a,idsa) (l2,_,idsb) = (joinLoc l1 l2, a, 'S'.union idsa idsb)
joinTypeDefs :: (LocationInModule, 'CDB'.TypeDefEntry) (LocationInModule, 'CDB'.TypeDefEntry) -> (LocationInModule, 'CDB'.TypeDefEntry)
joinTypeDefs (a,t) (b,u) = (joinLoc a b, 'CDB'.mergeTypeDefEntries t u)
......@@ -500,7 +527,7 @@ where
}
pd_module _ = zero
pd_rewriterules :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.FunctionEntry, [String])]
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}
, let doc = findDoc hideIsUsedReturn id st in
......@@ -512,7 +539,7 @@ where
, fe_priority=findPrio id >>= 'T'.toMaybePriority
, fe_documentation=doc
}
, globalIdents pd
, (idents ICExpression pd).globals
) \\ pd=:(PD_Function pos id isinfix args rhs _) <- defs]
where
priostring :: Ident ParsedDefinition -> String
......@@ -543,7 +570,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, [String])]
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}
, { zero
......@@ -553,10 +580,10 @@ where
, fe_documentation=findDoc hideIsUsedReturn id st
, fe_derivations=Just []
}
, []
, 'S'.newSet
) \\ gen=:(PD_Generic {gen_ident=id=:{id_name},gen_pos,gen_type,gen_vars}) <- defs]
pd_typespecs :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.FunctionEntry, [String])]
pd_typespecs :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.FunctionEntry, 'S'.Set String)]
pd_typespecs dcl defs st
= [( setLine dcl pos {zero & name=Just id_name}
, { zero
......@@ -565,7 +592,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
, (idents ICExpression [pd \\ pd=:(PD_Function _ id _ _ _ _) <- defs | id.id_name == id_name]).globals
) \\ ts=:(PD_TypeSpec pos id=:{id_name} p (Yes t) funspecs) <- defs]
pd_class_derivations :: !Bool ![ParsedDefinition] SymbolTable -> [('CDB'.Name, 'CDB'.Type, String, LocationInModule)]
......@@ -581,7 +608,7 @@ 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, [String])])]
pd_classes :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.ClassEntry, [(String, 'CDB'.FunctionEntry, 'S'.Set String)])]
pd_classes dcl defs st
= [ let
typespecs = pd_typespecs True clsdefs st
......
......@@ -73,7 +73,7 @@ getEntries :: *(DB v ak a) -> *([(v, Map ak a)], *DB v ak a)
/**
* An in-place map over all entries (also the excluded ones).
*/
mapInPlace :: (v -> v) *(DB v ak a) -> *(DB v ak a)
mapInPlace :: (Int v -> v) *(DB v ak a) -> *(DB v ak a)
/**
* Linear search for entries. The search function returns whether the entry
......
......@@ -7,7 +7,7 @@ import StdInt
import StdString
import StdTuple
from Data.Func import $
from Data.Func import $, hyperstrict
import Data.Functor
import Data.Map
import Data.Maybe
......@@ -23,7 +23,7 @@ instance == Index where == (Index a) (Index b) = a == b
instance < Index where < (Index a) (Index b) = a < b
newDB :: [v] -> *DB v ak a
newDB vs = DB {{value=v,included=True,annotations=newMap} \\ v <- vs}
newDB vs = DB {{value=hyperstrict v,included=True,annotations=newMap} \\ v <- vs}
saveDB :: *(DB v ak a) *File -> *(*DB v ak a, *File) | JSONEncode{|*|} v
saveDB (DB db) f
......@@ -98,15 +98,17 @@ where
# (r,es) = collect (i-1) es
= (if e.included [(e.value,e.annotations):r] r, es)
mapInPlace :: (v -> v) *(DB v ak a) -> *(DB v ak a)
mapInPlace :: (Int v -> v) *(DB v ak a) -> *(DB v ak a)