<> <> <> <> DIRECTORY CD, CDCacheBase, CDGenerate, CDGenerateBackdoor, CDDirectory, CDMenuSpecials, CDProperties, Rope, SymTab; CDGenerateImpl: CEDAR MONITOR IMPORTS CDCacheBase, CDDirectory, CDMenuSpecials, CDProperties, SymTab EXPORTS CDGenerate, CDGenerateBackdoor SHARES CDDirectory = BEGIN publicContexts: PUBLIC SymTab.Ref _ SymTab.Create[case: TRUE]; Context: TYPE = CDGenerate.Context; ContextRep: TYPE = CDGenerate.ContextRep; GeneratorProc: TYPE = CDGenerate.GeneratorProc; IGeneratorProc: TYPE = CDGenerateBackdoor.IGeneratorProc; SelectorProc: TYPE = CDGenerateBackdoor.SelectorProc; Registration: TYPE = RECORD [generator: GeneratorProc, cache: BOOL, data: REF]; Entry: TYPE = RECORD [ob: CD.Object, registration: REF Registration, lastChange: REF_NIL]; Indirection: TYPE = RECORD [onTopOf: Context, iGenerator: IGeneratorProc, selector: SelectorProc, flush: BOOL, clear: BOOL, register: BOOL]; GetCache: ENTRY PROC [context: Context, design: CD.Design] RETURNS [cache: SymTab.Ref] = { ENABLE UNWIND => NULL; WITH CDProperties.GetDesignProp[design, context] SELECT FROM symtab: SymTab.Ref => cache _ symtab; ENDCASE => { cache _ SymTab.Create[case: context.case]; CDProperties.PutDesignProp[design, context, cache]; }; }; OkObject: PROC [design: CD.Design, entry: REF Entry] RETURNS [ok: BOOL_TRUE] = { IF entry.ob.class.composed AND ~entry.ob.immutable THEN { IF ~CDDirectory.CompatibleOwner[design, entry.ob] THEN RETURN [ok_FALSE]; ok _ CDCacheBase.Match[[entry.ob, entry.lastChange]]; }; }; Create: PUBLIC PROC [case: BOOL _ TRUE, cache: BOOL _ TRUE] RETURNS [context: Context] = { context _ NEW[ContextRep_[rep: SymTab.Create[case: case, mod: 51], case: case, cache: cache]]; }; CreateIndirect: PUBLIC PROC [onTopOf: Context, iGenerator: IGeneratorProc, selector: SelectorProc_NIL, cache: BOOL _ TRUE, flushThrough: BOOL _ TRUE, clearThrough: BOOL _ TRUE, registerThrough: BOOL _ TRUE] RETURNS [context: Context] = { ind: REF Indirection _ NEW[Indirection _ [iGenerator: iGenerator, onTopOf: onTopOf, selector: selector, flush: flushThrough, clear: clearThrough, register: registerThrough]]; context _ NEW[ContextRep _ [rep: ind, case: onTopOf.case, cache: cache AND onTopOf.cache]]; }; Indiretee: PUBLIC PROC [context: Context] RETURNS [Context] = { <<--NIL if not indirect>> WITH context.rep SELECT FROM ind: REF Indirection => RETURN [ind.onTopOf] ENDCASE => RETURN [NIL] }; Clear: PUBLIC PROC [context: Context] = { WITH context.rep SELECT FROM symtab: SymTab.Ref => { EachPair: SymTab.EachPairAction = { [] _ symtab.Delete[key]; quit _ FALSE; }; [] _ symtab.Pairs[EachPair]; }; ind: REF Indirection => IF ind.clear THEN Clear[ind.onTopOf]; ENDCASE => ERROR }; Register: PUBLIC PROC [context: Context, key: Rope.ROPE, generator: GeneratorProc, cache: BOOL, data: REF] RETURNS [first: BOOL] = { WITH context.rep SELECT FROM symtab: SymTab.Ref => { IF generator=NIL THEN first _ ~ symtab.Delete[key] ELSE first _ symtab.Store[key, NEW[Registration _ [generator: generator, cache: cache AND context.cache, data: data]]] }; ind: REF Indirection => IF ind.register THEN RETURN [Register[ind.onTopOf, key, generator, cache, data]]; ENDCASE => ERROR }; FetchRegRef: PROC [context: Context, key: Rope.ROPE] RETURNS [reg: REF Registration_NIL] = { <<--fetches registration of real generator>> WITH context.rep SELECT FROM symtab: SymTab.Ref => WITH symtab.Fetch[key].val SELECT FROM reg: REF Registration => RETURN [reg]; ENDCASE => NULL; ind: REF Indirection => RETURN [FetchRegRef[ind.onTopOf, key]] ENDCASE => NULL; }; FetchRegistration: PUBLIC PROC [context: Context, key: Rope.ROPE] RETURNS [generator: GeneratorProc_NIL, cache: BOOL_FALSE, data: REF_NIL] = { <<--cache means original registration and is not updated according to any indirection>> reg: REF Registration = FetchRegRef[context, key]; IF reg#NIL THEN { generator _ reg.generator; cache _ reg.cache AND context.cache; data _ reg.data }; }; FetchCached: PUBLIC PROC[context: Context, design: CD.Design, key: Rope.ROPE] RETURNS [ob: CD.Object_NIL] = { <<--returns NIL if not found, not cached or looks different>> IF context.cache THEN { reg: REF Registration _ FetchRegRef[context, key]; IF reg=NIL OR reg.cache THEN { obCache: SymTab.Ref _ GetCache[context, design]; entry: REF Entry _ NARROW[obCache.Fetch[key].val]; IF entry#NIL AND entry.registration=reg THEN { IF OkObject[design, entry] THEN RETURN [entry.ob] ELSE [] _ obCache.Delete[key] } } } }; <<>> FetchNCall: PUBLIC PROC[context: Context, design: CD.Design, key: Rope.ROPE, cache: BOOL] RETURNS [ob: CD.Object_NIL] = { <<--returns NIL if not found or generated>> ob _ FetchIndirect[passContext: context, realContext: context, design: design, key: key, cache: cache] }; <<>> Flush: PUBLIC PROC [context: Context, design: CD.Design, key: Rope.ROPE] = { <<--Removes this entry from the cache>> IF context.cache THEN { cache: SymTab.Ref _ GetCache[context, design]; [] _ cache.Delete[key] }; WITH context.rep SELECT FROM ind: REF Indirection => IF ind.flush THEN Flush[ind.onTopOf, design, key]; ENDCASE => NULL; }; <<>> FlushAll: PUBLIC PROC [context: Context, design: CD.Design] = { <<--Removes all entries from the cache>> IF context.cache THEN { cache: SymTab.Ref _ SymTab.Create[case: context.case]; CDProperties.PutDesignProp[design, context, cache] }; WITH context.rep SELECT FROM ind: REF Indirection => IF ind.flush THEN FlushAll[ind.onTopOf, design] ENDCASE => NULL; }; <<>> SelectOneOf: PUBLIC PROC[context: Context, label: Rope.ROPE] RETURNS [key: Rope.ROPE_NIL] = { <<--Interactive selection>> <<--NIL if discarded>> WITH context.rep SELECT FROM symtab: SymTab.Ref => key _ CDMenuSpecials.SelectOneOf[symtab, label]; ind: REF Indirection => { IF ind.selector=SelectOneOf THEN key _ SelectOneOf[ind.onTopOf, label] ELSE IF ind.selector#NIL THEN key _ ind.selector[context, label] }; ENDCASE => ERROR }; AssertContext: PUBLIC PROC [project: Rope.ROPE] RETURNS [context: Context] = { <<--Fetches a context; if not done then create one and store it for next call of AssertContext.>> <<--This context can be imported by lots of unknown applications...>> WITH publicContexts.Fetch[project].val SELECT FROM tab: Context => context _ tab; ENDCASE => { [] _ publicContexts.Insert[project, Create[]]; context _ AssertContext[project]; } }; FetchIndirect: PUBLIC PROC [passContext, realContext: Context, design: CD.Design, key: Rope.ROPE, cache: BOOL_FALSE] RETURNS [ob: CD.Object_NIL] = { <<--Like FetchNCall except: >> <<--passContext will be passed trough only >> <<--realContext context to be really called. >> <<--To be called from indirection generators>> reg: REF Registration_NIL; obCache: SymTab.Ref; entry: REF Entry_NIL; <<--check fetch from cache>> IF cache AND realContext.cache THEN { --THEN also onTopOf.cache ! reg _ FetchRegRef[realContext, key]; IF reg=NIL OR reg.cache THEN { obCache _ GetCache[realContext, design]; entry _ NARROW[obCache.Fetch[key].val]; IF entry#NIL AND entry.registration=reg THEN { IF OkObject[design, entry] THEN RETURN [entry.ob] ELSE [] _ obCache.Delete[key] }; }; }; <<--make an actual call...>> WITH realContext.rep SELECT FROM st: SymTab.Ref => { IF reg=NIL THEN reg _ FetchRegRef[realContext, key]; IF reg#NIL THEN ob _ reg.generator[design: design, key: key, context: passContext, data: reg.data]; }; ind: REF Indirection => { ob _ ind.iGenerator[design: design, key: key, passContext: passContext, realContext: realContext]; }; ENDCASE => ERROR; <<--store in cache>> IF cache AND realContext.cache THEN { IF reg=NIL OR reg.cache THEN { IF ob=NIL THEN [] _ obCache.Delete[key] ELSE { entry _ NEW[Entry _ [ob: ob, registration: reg, lastChange: CDCacheBase.CurrentKey[ob]]]; [] _ obCache.Store[key, entry]; } } }; }; END.