<> <> <> <> <> <> DIRECTORY Basics USING [bitsPerWord, BITXOR, BITAND, BITSHIFT, Comparison, LowHalf, HighHalf], PrioritySearchRef, SafeStorage USING [GetSystemZone]; PrioritySearchRefImpl: CEDAR PROGRAM IMPORTS Basics, SafeStorage EXPORTS PrioritySearchRef = BEGIN OPEN PrioritySearchRef; systemZone: ZONE = SafeStorage.GetSystemZone[]; <> <<>> <<>> Tree: TYPE = REF TreeObject _ NIL; TreeObject: PUBLIC TYPE = RECORD [ zone: ZONE, prefix: PROC [ Item, Item ] RETURNS[ RadixIndex ], treeHalf: PROC [ Item, RadixIndex ] RETURNS [ Half ], depth: PROC [ Item, Item ] RETURNS [ Basics.Comparison ], count: INT _ 0, root: REF Internal ]; Internal: TYPE = RECORD [ <> <<>> item: Item _ NIL, prefix: RadixIndex, halves: ARRAY Half OF REF _ ALL[NIL] -- {Item or REF Internal} ]; Create: PUBLIC PROC [ prefix: PROC [ Item, Item ] RETURNS [ RadixIndex ], treeHalf: PROC [ Item, RadixIndex ] RETURNS [ Half ], depth: PROC [ Item, Item ] RETURNS [ Basics.Comparison ], nodeZone, treeZone: ZONE _ NIL ] RETURNS [ Tree ] = BEGIN IF nodeZone=NIL THEN nodeZone _ systemZone; IF treeZone=NIL THEN treeZone _ systemZone; RETURN[treeZone.NEW[TreeObject _ [prefix: prefix, treeHalf: treeHalf, depth: depth, zone: nodeZone, root: nodeZone.NEW[Internal _ [prefix: 0]]]]]; END; Destroy: PUBLIC PROC [ tree: Tree ] RETURNS [ Tree ] = BEGIN t: REF TreeObject = NARROW[tree]; RETURN[NIL]; END; -- of Destroy Size: PUBLIC PROC [ tree: Tree ] RETURNS [ INT ] = BEGIN t: REF TreeObject = NARROW[tree]; RETURN[t.count]; END; Insert: PUBLIC PROC [ tree: Tree, item: Item ] RETURNS [ rejectedDuplicate: BOOL ] = BEGIN t: REF TreeObject = NARROW[tree]; prior: REF Internal _ t.root; half: Half _ lower; p: REF _ prior.halves[half]; <> WHILE p#NIL DO prefix: RadixIndex; WITH p SELECT FROM internal: REF Internal => BEGIN prefix _ t.prefix[item, internal.item]; IF prefix> BEGIN prior.halves[half] _ t.zone.NEW[Internal _ [prefix: prefix, halves: (IF t.treeHalf[item, prefix]=lower THEN [lower: item, upper: internal] ELSE [lower: internal, upper: item])]]; RefillItem[t, prior, half]; EXIT; END ELSE -- item and internal.item match in first internal.prefix bits BEGIN IF prefix=equal THEN RETURN[TRUE]; -- duplicate IF t.depth[item, internal.item]=less THEN BEGIN -- exchange item with internal.item t: Item _ internal.item; internal.item _ item; item _ t; END; prior _ internal; half _ t.treeHalf[item, internal.prefix]; p _ internal.halves[half]; END; END; ENDCASE => -- must be an Item BEGIN prefix _ t.prefix[item, p]; IF prefix=equal THEN RETURN[TRUE]; -- duplicate IF t.depth[item, p]=less THEN BEGIN -- exchange p with internal.item t: Item _ p; p _ item; item _ t; END; prior.halves[half] _ t.zone.NEW[Internal _ [item: p, prefix: prefix, halves: (IF t.treeHalf[item, prefix]=lower THEN [lower: item, upper: NIL] ELSE [lower: NIL, upper: item])]]; EXIT; END; REPEAT FINISHED => prior.halves[half] _ item; ENDLOOP; t.count _ t.count+1; <> RETURN[FALSE]; END; -- of Insert CouldntDelete: PUBLIC ERROR = CODE; Delete: PUBLIC PROC [ tree: Tree, item: Item ] = BEGIN t: REF TreeObject _ NARROW[tree]; prior: REF Internal _ t.root; half: Half _ lower; p: REF _ prior.halves[half]; <> WHILE p#NIL DO WITH p SELECT FROM internal: REF Internal => BEGIN IF item=internal.item THEN BEGIN RefillItem[t, prior, half]; EXIT; END ELSE BEGIN prior _ internal; half _ t.treeHalf[item, internal.prefix]; p _ internal.halves[half]; END; END; ENDCASE => IF item=p THEN BEGIN prior.halves[half] _ NIL; EXIT; END ELSE ERROR CouldntDelete; REPEAT FINISHED => ERROR CouldntDelete; ENDLOOP; t.count _ t.count-1; <> END; -- of Delete RefillItem: PROC [ t: REF TreeObject, prior: REF Internal, half: Half ] = BEGIN -- assumes prior#NIL p: REF _ prior.halves[half]; DO WITH p SELECT FROM internal: REF Internal => SELECT TRUE FROM internal.halves[lower]=NIL => {prior.halves[half] _ internal.halves[upper]; EXIT}; internal.halves[upper]=NIL => {prior.halves[half] _ internal.halves[lower]; EXIT}; ENDCASE => BEGIN lowerItem: Item _ (WITH internal.halves[lower] SELECT FROM lowerInternal: REF Internal => lowerInternal.item, ENDCASE => internal.halves[lower]); upperItem: Item _ (WITH internal.halves[upper] SELECT FROM upperInternal: REF Internal => upperInternal.item, ENDCASE => internal.halves[upper]); IF t.depth[lowerItem, upperItem]=less THEN BEGIN internal.item _ lowerItem; half _ lower; END ELSE BEGIN internal.item _ upperItem; half _ upper; END; prior _ internal; p _ internal.halves[half]; END; ENDCASE => {prior.halves[half] _ NIL; EXIT}; ENDLOOP; END; -- of RefillItem Check: PUBLIC PROC [ tree: Tree, itemProc: UNSAFE PROC[Item] _ NIL ] = TRUSTED BEGIN InternalCheck: PROC [ p: REF, half: Half, item: Item, prefix: INT ] = TRUSTED BEGIN IF p#NIL THEN BEGIN count _ count+1; WITH p SELECT FROM internal: REF Internal => BEGIN IF internal.prefix<=prefix OR (0<=prefix AND (t.prefix[internal.item, item] BEGIN IF 0<=prefix AND (t.prefix[p, item]> <> <> <> InternalSearch: PROC [ p: REF ] = TRUSTED BEGIN WHILE p#NIL DO WITH p SELECT FROM internal: REF Internal => IF t.depth[internal.item, deepestItem]#greater THEN BEGIN i: Item = internal.item; lPrefix, uPrefix: RadixIndex; IF ((lPrefix _ t.prefix[i, lowermostItem]) -- an Item BEGIN IF t.depth[p, deepestItem]#greater AND t.treeHalf[p, t.prefix[p, lowermostItem]]=upper AND t.treeHalf[p, t.prefix[p, uppermostItem]]=lower THEN touch[p]; EXIT; END; ENDLOOP; END; -- of InternalSearch t: REF TreeObject _ NARROW[tree]; InternalSearch[t.root.halves[lower]]; END; -- of Search <> <> TreeHalfImpl: PUBLIC PROC [ value: LONG UNSPECIFIED, i: RadixIndex ] RETURNS[ Half ] = TRUSTED BEGIN OPEN Basics; RETURN[IF (IF i