DIRECTORY Alloc: TYPE USING [ Handle, Notifier, AddNotify, DropNotify, FreeChunk, GetChunk], Literals: TYPE USING [LitIndex], Symbols: TYPE USING [HTIndex, ISEIndex], Tree: TYPE USING [ AttrId, Base, Finger, Id, Index, Info, Link, Map, Node, NodeName, Scan, Test, maxNSons, null, nullIndex, treeType], TreeOps: TYPE USING []; TreePack: PROGRAM IMPORTS Alloc EXPORTS TreeOps = PUBLIC { endIndex: Tree.Index = Tree.Index.LAST; endMark: Tree.Link = [subtree[index: endIndex]]; initialized: PRIVATE BOOL _ FALSE; table: PRIVATE Alloc.Handle; LinkSeq: PRIVATE TYPE = RECORD [SEQUENCE length: CARDINAL OF Tree.Link]; LinkStack: PRIVATE TYPE = REF LinkSeq; stack: PRIVATE LinkStack; sI: PRIVATE CARDINAL; tb: PRIVATE Tree.Base; -- tree base UpdateBase: PRIVATE Alloc.Notifier = {tb _ base[Tree.treeType]}; Initialize: PROC [ownTable: Alloc.Handle] = { IF initialized THEN Finalize[]; stack _ NEW[LinkSeq[250]]; sI _ 0; table _ ownTable; table.AddNotify[UpdateBase]; IF MakeNode[$none,0] # Tree.null THEN ERROR; -- reserve null initialized _ TRUE}; Reset: PROC = { IF initialized AND stack.length > 250 THEN { stack _ NEW[LinkSeq[250]]}}; Finalize: PROC = { table.DropNotify[UpdateBase]; table _ NIL; stack _ NIL; initialized _ FALSE}; ExpandStack: PRIVATE PROC = { newStack: LinkStack = NEW[LinkSeq[stack.length + 256]]; FOR i: CARDINAL IN [0 .. stack.length) DO newStack[i] _ stack[i] ENDLOOP; stack _ newStack}; PushTree: PROC [v: Tree.Link] = { IF sI >= stack.length THEN ExpandStack[]; stack[sI] _ v; sI _ sI+1}; PopTree: PROC RETURNS [Tree.Link] = {RETURN [stack[sI_sI-1]]}; InsertTree: PROC [v: Tree.Link, n: CARDINAL] = { i: CARDINAL; IF sI >= stack.length THEN ExpandStack[]; i _ sI; sI _ sI+1; THROUGH [1 .. n) DO stack[i] _ stack[i-1]; i _ i-1 ENDLOOP; stack[i] _ v}; ExtractTree: PROC [n: CARDINAL] RETURNS [v: Tree.Link] = { i: CARDINAL _ sI - n; v _ stack[i]; THROUGH [1 .. n) DO stack[i] _ stack[i+1]; i _ i+1 ENDLOOP; sI _ sI - 1; RETURN [v]}; MakeNode: PROC [name: Tree.NodeName, count: INTEGER] RETURNS [Tree.Link] = { PushNode[name, count]; RETURN [PopTree[]]}; MakeList: PROC [size: INTEGER] RETURNS [Tree.Link] = { PushList[size]; RETURN [PopTree[]]}; PushNode: PROC [name: Tree.NodeName, count: INTEGER] = { nSons: CARDINAL = count.ABS; node: Tree.Index = table.GetChunk[Tree.Node.SIZE+nSons*Tree.Link.SIZE, Tree.treeType]; i: CARDINAL; tb[node].name _ name; tb[node].nSons _ nSons; tb[node].info _ 0; tb[node].shared _ FALSE; tb[node].attrs _ ALL[FALSE]; IF count >= 0 THEN FOR i _ nSons, i-1 WHILE i >= 1 DO tb[node].son[i] _ stack[sI_sI-1] ENDLOOP ELSE FOR i _ 1, i+1 WHILE i <= nSons DO tb[node].son[i] _ stack[sI_sI-1] ENDLOOP; IF sI >= stack.length THEN ExpandStack[]; stack[sI] _ [subtree[index: node]]; sI _ sI+1}; PushList: PROC [size: INTEGER] = { nSons: CARDINAL = size.ABS; node: Tree.Index; i: CARDINAL; SELECT nSons FROM 1 => NULL; 0 => PushTree[Tree.null]; ENDCASE => { IF nSons IN (0..Tree.maxNSons] THEN node _ table.GetChunk[Tree.Node.SIZE+nSons*Tree.Link.SIZE, Tree.treeType] ELSE { node _ table.GetChunk[Tree.Node.SIZE+(nSons+1)*Tree.Link.SIZE, Tree.treeType]; tb[node].son[nSons+1] _ endMark}; tb[node].name _ $list; tb[node].info _ 0; tb[node].shared _ FALSE; tb[node].attrs _ ALL[FALSE]; tb[node].nSons _ IF nSons IN (0..Tree.maxNSons] THEN nSons ELSE 0; IF size > 0 THEN FOR i _ nSons, i-1 WHILE i >= 1 DO tb[node].son[i] _ stack[sI_sI-1] ENDLOOP ELSE FOR i _ 1, i+1 WHILE i <= nSons DO tb[node].son[i] _ stack[sI_sI-1] ENDLOOP; IF sI >= stack.length THEN ExpandStack[]; stack[sI] _ [subtree[index: node]]; sI _ sI+1}}; PushProperList: PROC [size: INTEGER] = { IF size IN [-1..1] THEN { node: Tree.Index = table.GetChunk[Tree.Node.SIZE+Tree.Link.SIZE, Tree.treeType]; tb[node].name _ $list; tb[node].info _ 0; tb[node].shared _ FALSE; tb[node].attrs _ ALL[FALSE]; tb[node].nSons _ size.ABS; tb[node].son[1] _ IF size = 0 THEN endMark ELSE PopTree[]; PushTree[[subtree[index: node]]]} ELSE PushList[size]}; PushHash: PROC [hti: Symbols.HTIndex] = {PushTree[[hash[index: hti]]]}; PushSe: PROC [sei: Symbols.ISEIndex] = {PushTree[[symbol[index: sei]]]}; PushLit: PROC [lti: Literals.LitIndex] = {PushTree[[literal[index: lti]]]}; SetInfo: PROC [info: Tree.Info] = { WITH stack[sI-1] SELECT FROM v: Tree.Link.subtree => IF v # Tree.null THEN tb[v.index].info _ info; ENDCASE}; SetAttr: PROC [attr: Tree.AttrId, value: BOOL] = { WITH stack[sI-1] SELECT FROM v: Tree.Link.subtree => IF v = Tree.null THEN ERROR ELSE tb[v.index].attrs[attr] _ value; ENDCASE => ERROR}; FreeNode: PROC [node: Tree.Index] = { IF node # Tree.nullIndex AND ~tb[node].shared THEN { i: CARDINAL; t: Tree.Link; n: CARDINAL _ tb[node].nSons; IF tb[node].name # $list OR n # 0 THEN FOR i _ 1, i+1 WHILE i <= n DO t _ tb[node].son[i]; WITH t SELECT FROM subtree => FreeNode[index] ENDCASE; ENDLOOP ELSE { n _ 1; FOR i _ 1, i+1 UNTIL (t_tb[node].son[i]) = endMark DO WITH t SELECT FROM subtree => FreeNode[index] ENDCASE; n _ n+1; ENDLOOP}; table.FreeChunk[node, Tree.Node.SIZE+n*Tree.Link.SIZE, Tree.treeType]}}; FreeTree: PROC [t: Tree.Link] RETURNS [Tree.Link] = { WITH t SELECT FROM subtree => FreeNode[index]; ENDCASE; RETURN [Tree.null]}; GetHash: PROC [t: Tree.Link] RETURNS [Symbols.HTIndex] = { RETURN [NARROW[t, Tree.Link.hash].index]}; GetNode: PROC [t: Tree.Link] RETURNS [Tree.Index] = { RETURN [NARROW[t, Tree.Link.subtree].index]}; GetSe: PROC [t: Tree.Link] RETURNS [Symbols.ISEIndex] = { RETURN [NARROW[t, Tree.Link.symbol].index]}; NthSon: PROC [t: Tree.Link, n: CARDINAL] RETURNS [Tree.Link] = { RETURN [IF t = Tree.null THEN ERROR ELSE tb[NARROW[t, Tree.Link.subtree].index].son[n]]}; OpName: PROC [t: Tree.Link] RETURNS [Tree.NodeName] = { RETURN [IF t = Tree.null THEN $none ELSE WITH t SELECT FROM subtree => tb[index].name ENDCASE => $none]}; GetAttr: PROC [t: Tree.Link, attr: Tree.AttrId] RETURNS [BOOL] = { RETURN [IF t # Tree.null THEN tb[NARROW[t, Tree.Link.subtree].index].attrs[attr] ELSE ERROR]}; PutAttr: PROC [t: Tree.Link, attr: Tree.AttrId, value: BOOL] = { IF t = Tree.null THEN ERROR; tb[NARROW[t, Tree.Link.subtree].index].attrs[attr] _ value}; GetInfo: PROC [t: Tree.Link] RETURNS [Tree.Info] = { RETURN [IF t # Tree.null THEN tb[NARROW[t, Tree.Link.subtree].index].info ELSE ERROR]}; PutInfo: PROC [t: Tree.Link, value: Tree.Info] = { IF t = Tree.null THEN ERROR; tb[NARROW[t, Tree.Link.subtree].index].info _ value}; Shared: PROC [t: Tree.Link] RETURNS [BOOL] = { RETURN [WITH t SELECT FROM subtree => IF t = Tree.null THEN FALSE ELSE tb[index].shared, ENDCASE => FALSE]}; MarkShared: PROC [t: Tree.Link, shared: BOOL] = { WITH t SELECT FROM subtree => IF t # Tree.null THEN tb[index].shared _ shared; ENDCASE}; SonCount: PRIVATE PROC [node: Tree.Index] RETURNS [CARDINAL] = INLINE { RETURN [SELECT node FROM Tree.nullIndex, endIndex => 0, ENDCASE => IF tb[node].name = $list AND tb[node].nSons = 0 THEN ListLength[[subtree[index: node]]] ELSE tb[node].nSons]}; ScanSons: PROC [root: Tree.Link, action: Tree.Scan] = { IF root # Tree.null THEN WITH root SELECT FROM subtree => { node: Tree.Index = index; FOR i: CARDINAL IN [1 .. SonCount[node]] DO action[tb[node].son[i]] ENDLOOP}; ENDCASE; RETURN}; UpdateLeaves: PROC [root: Tree.Link, map: Tree.Map] RETURNS [v: Tree.Link] = { IF root = Tree.null THEN v _ Tree.null ELSE WITH root SELECT FROM subtree => { node: Tree.Index = index; FOR i: CARDINAL IN [1 .. SonCount[node]] DO tb[node].son[i] _ map[tb[node].son[i]]; ENDLOOP; v _ root}; ENDCASE => v _ map[root]; RETURN}; ListLength: PROC [t: Tree.Link] RETURNS [CARDINAL] = { IF t = Tree.null THEN RETURN [0]; WITH t SELECT FROM subtree => { node: Tree.Index = index; n: CARDINAL; IF tb[node].name # $list THEN RETURN [1]; n _ tb[node].nSons; IF n # 0 THEN RETURN [n]; FOR i: CARDINAL _ 1, i+1 UNTIL tb[node].son[i] = endMark DO n _ n+1 ENDLOOP; RETURN [n]}; ENDCASE => RETURN [1]}; ListHead: PROC [t: Tree.Link] RETURNS [Tree.Link] = { IF t = Tree.null THEN RETURN [Tree.null]; WITH t SELECT FROM subtree => { node: Tree.Index = index; RETURN [SELECT TRUE FROM (tb[node].name # $list) => t, (tb[node].son[1] # endMark) => tb[node].son[1], ENDCASE => Tree.null]}; ENDCASE => RETURN [t]}; ListTail: PROC [t: Tree.Link] RETURNS [Tree.Link] = { IF t = Tree.null THEN RETURN [Tree.null]; WITH t SELECT FROM subtree => { node: Tree.Index = index; RETURN [SELECT TRUE FROM (tb[node].name # $list) => t, (tb[node].son[1] # endMark) => tb[node].son[ListLength[t]], ENDCASE => Tree.null]}; ENDCASE => RETURN [t]}; ScanList: PROC [root: Tree.Link, action: Tree.Scan] = { IF root # Tree.null THEN WITH root SELECT FROM subtree => { node: Tree.Index = index; i, n: CARDINAL; t: Tree.Link; IF tb[node].name # $list THEN action[root] ELSE IF (n _ tb[node].nSons) # 0 THEN FOR i _ 1, i+1 WHILE i <= n DO action[tb[node].son[i]] ENDLOOP ELSE FOR i _ 1, i+1 UNTIL (t_tb[node].son[i]) = endMark DO action[t] ENDLOOP}; ENDCASE => action[root]}; ReverseScanList: PROC [root: Tree.Link, action: Tree.Scan] = { IF root # Tree.null THEN WITH root SELECT FROM subtree => { node: Tree.Index = index; IF tb[node].name # $list THEN action[root] ELSE FOR i: CARDINAL DECREASING IN [1 .. ListLength[root]] DO action[tb[node].son[i]] ENDLOOP}; ENDCASE => action[root]}; SearchList: PROC [root: Tree.Link, test: Tree.Test] = { IF root # Tree.null THEN WITH root SELECT FROM subtree => { node: Tree.Index = index; i, n: CARDINAL; t: Tree.Link; IF tb[node].name # $list THEN [] _ test[root] ELSE IF (n _ tb[node].nSons) # 0 THEN FOR i _ 1, i+1 WHILE i <= n DO IF test[tb[node].son[i]] THEN EXIT ENDLOOP ELSE FOR i _ 1, i+1 UNTIL (t_tb[node].son[i]) = endMark DO IF test[t] THEN EXIT ENDLOOP}; ENDCASE => [] _ test[root]}; UpdateList: PROC [root: Tree.Link, map: Tree.Map] RETURNS [Tree.Link] = { IF root = Tree.null THEN RETURN [Tree.null]; WITH root SELECT FROM subtree => { node: Tree.Index = index; i, n: CARDINAL; t: Tree.Link; IF tb[node].name # $list THEN RETURN [map[root]]; IF (n _ tb[node].nSons) # 0 THEN FOR i _ 1, i+1 WHILE i <= n DO tb[node].son[i] _ map[tb[node].son[i]] ENDLOOP ELSE FOR i _ 1, i+1 UNTIL (t_tb[node].son[i]) = endMark DO tb[node].son[i] _ map[t] ENDLOOP; RETURN [root]}; ENDCASE => RETURN [map[root]]}; ReverseUpdateList: PROC [root: Tree.Link, map: Tree.Map] RETURNS [Tree.Link] = { IF root = Tree.null THEN RETURN [Tree.null]; WITH root SELECT FROM subtree => { node: Tree.Index = index; IF tb[node].name # $list THEN RETURN [map[root]]; FOR i: CARDINAL DECREASING IN [1..ListLength[root]] DO tb[node].son[i] _ map[tb[node].son[i]] ENDLOOP; RETURN [root]}; ENDCASE => RETURN [map[root]]}; CopyTree: PROC [root: Tree.Id, map: Tree.Map] RETURNS [v: Tree.Link] = { WITH root.link SELECT FROM subtree => { sNode: Tree.Index = index; IF sNode = Tree.nullIndex THEN v _ Tree.null ELSE { size: CARDINAL = NodeSize[root.baseP, sNode]; dNode: Tree.Index = table.GetChunk[size, Tree.treeType]; t: Tree.Link; tb[dNode].name _ root.baseP^[sNode].name; tb[dNode].shared _ FALSE; tb[dNode].nSons _ root.baseP^[sNode].nSons; tb[dNode].info _ root.baseP^[sNode].info; tb[dNode].attrs _ root.baseP^[sNode].attrs; FOR i: CARDINAL IN [1..size-Tree.Node.SIZE] DO tb[dNode].son[i] _ IF (t_root.baseP^[sNode].son[i]) = endMark THEN endMark ELSE map[t]; ENDLOOP; v _ [subtree[index: dNode]]}}; ENDCASE => v _ map[root.link]; RETURN}; IdentityMap: Tree.Map = { RETURN [IF ISTYPE[t, Tree.Link.subtree] AND ~Shared[t] THEN CopyTree[[baseP:@tb, link:t], IdentityMap] ELSE t]}; NodeSize: PROC [baseP: Tree.Finger, node: Tree.Index] RETURNS [size: CARDINAL] = { IF node = Tree.nullIndex THEN size _ 0 ELSE IF baseP^[node].name # $list OR baseP^[node].nSons # 0 THEN size _ Tree.Node.SIZE + baseP^[node].nSons*Tree.Link.SIZE ELSE { size _ Tree.Node.SIZE + Tree.Link.SIZE; FOR i: CARDINAL _ 1, i+1 UNTIL baseP^[node].son[i] = endMark DO size _ size + Tree.Link.SIZE ENDLOOP}; RETURN}; }. "file ProtoTreePack.mesa last modified by Satterthwaite, January 10, 1983 2:59 pm last modified by Paul Rovner, September 9, 1983 8:53 am procedures for tree testing procedures for tree traversal procedures for list testing procedures for list traversal cross-table tree manipulation ʘJšœ™Jšœ8™8Jšœ7™7J˜šÏk ˜ šœœœ˜J˜>—Jšœ œœ ˜ Jšœ œœ˜(šœœœ˜J˜MJ˜%—Jšœ œœ˜J˜—šœ ˜Jšœ˜Jšœ ˜Jšœ˜˜Jšœ"œ˜'J˜0J˜Jšœ œœœ˜"J˜Jšœœ˜J˜Jš œ œœœœ œœ ˜HJšœ œœœ ˜&J˜Jšœœ ˜Jšœœœ˜J˜Jšœœ Ïc ˜$J˜Jšœ œ-˜@J˜J˜šÏn œœ˜-Jšœ œ ˜Jšœœ˜#J˜J˜Jšœœœž˜J˜J˜šŸ œœœ˜0Jšœœ˜ Jšœœ˜)J˜Jšœ œ œ˜;J˜J˜—šŸ œœœœ˜:Jšœœ ˜J˜ Jšœ œ œ˜;J˜ Jšœ˜ J˜J˜—šŸœœœœ˜LJšœœ˜,J˜—šŸœœœœ˜6Jšœœ˜%J˜J˜—šŸœœœ˜8Jšœœ œ˜Jšœ,œœ˜VJšœœ˜ J˜.Jšœ&œ˜,Jšœœœ˜šœ ˜Jšœœœ"˜K—š˜Jšœ œ œ"œ˜L—Jšœœ˜)J˜0J˜—šŸœœœ˜"Jšœœœ˜J˜Jšœœ˜ šœ˜Jšœœ˜ J˜šœ˜ šœœ˜#Jšœ œœ˜I—šœ˜Jšœ œœ˜NJ˜!—J˜Jšœ&œ˜,Jšœœœ˜Jš œœœœœ˜Bšœ ˜Jšœœœ"˜K—š˜Jšœ œ œ"œ˜L—Jšœœ˜)J˜1J˜———šŸœœœ˜(šœœ œ˜Jšœ,œ œ˜PJ˜Jšœ&œ˜,Jšœœœ˜Jšœœ˜Jšœœ œ œ ˜:J˜!—Jšœ˜J˜J˜—JšŸœœ9˜GJ˜JšŸœœ<˜HJ˜JšŸœœ>˜KJ˜J˜šŸœœ˜#šœ œ˜Jšœœœ˜FJšœ˜ J˜——šŸœœœ˜2šœ œ˜˜Jšœœ˜Jšœ!˜%—Jšœœ˜J˜J˜——šŸœœ˜%šœœœ˜4Jšœœ˜ J˜ Jšœœ˜šœœ˜&šœ œ˜J˜Jšœœœœ˜6Jš˜——šœ˜J˜šœ œ˜5Jšœœœœ˜6J˜Jšœ˜ ——Jšœ œ œ˜HJ˜——šŸœœœ˜5Jšœœœœ˜9Jšœ˜J˜J˜—Jšœ™J˜šŸœœœ˜:Jšœœ˜*J˜—šŸœœœ˜5Jšœœ˜-J˜—šŸœœœ˜9Jšœœ˜,J˜—šŸœœœœ˜@šœœ˜Jšœ˜ Jšœœ'˜5J˜——šŸœœœ˜7šœœ˜Jšœ˜ Jš œœœœœ ˜EJ˜——šŸœœ#œœ˜Bšœœ˜Jšœœ)˜7Jšœœ˜ J˜——šŸœœ*œ˜@Jšœœœ˜Jšœœ3˜—š˜Jšœ œœ œ˜I——Jšœ˜J˜———šŸœœ)˜>šœ˜šœœ˜˜ J˜Jšœœ ˜*š˜š œœ œœ˜8Jšœœ˜!———Jšœ˜J˜———šŸ œœ'˜7šœ˜šœœ˜˜ J˜Jšœœ˜J˜ Jšœœ˜-šœœ˜%Jš œ œœœœœ˜I—š˜šœ œ˜5Jšœ œœœ˜———Jšœ˜J˜———šŸ œœ"œ˜IJšœœœ ˜,šœœ˜˜ J˜Jšœœ˜J˜ Jšœœœ ˜1šœ˜ Jšœ œœ(˜M—š˜šœ œ˜5Jšœœ˜!——Jšœ ˜—Jšœœ˜J˜——šŸœœ"œ˜PJšœœœ ˜,šœœ˜˜ J˜Jšœœœ ˜1š œœ œœ˜6Jšœ'œ˜/—Jšœ ˜—Jšœœ˜J˜J˜———Jšœ™˜šŸœœ œ˜Hšœ œ˜˜ J˜Jšœœ˜,šœ˜Jšœœ˜-J˜8J˜ J˜)Jšœœ˜J˜+J˜)J˜+š œœœœ˜.šœœ(˜=Jšœ˜ Jšœ˜ —Jšœ˜—J˜——Jšœ˜—Jšœ˜J˜—˜šœœœœ ˜6Jšœ+˜/Jšœ˜ J˜J˜——šŸœœ(œœ˜RJšœœ ˜&šœœœ˜@Jšœœ ˜9—šœ˜Jšœœ œ˜'šœœ œ˜?Jšœœœ˜&——Jšœ˜J˜—J˜J˜———…—.x@·