-- file SMTreeImpl.mesa
-- last modified by Satterthwaite, June 27, 1983 9:47 am
-- last edit by Schmidt, 16-Mar-82 16:02:03

DIRECTORY
  SMTree: TYPE Tree USING [
    AttrId, Ext, Handle, Id, Info, Link, Name, Node, NodeName, SonId,
    null, nullHandle],
  SMTreeOps: TYPE --TreeOps-- USING [Map, Scan, Test];
 
SMTreeImpl: CEDAR PROGRAM EXPORTS SMTreeOps ~ {
  OPEN Tree~~SMTree, TreeOps~~SMTreeOps;

  LinkStack: TYPE~RECORD[SEQUENCE size: NAT OF Tree.Link];
  stackIncr: NAT~128;

  TreeManager: PUBLIC TYPE~RECORD[
    z: ZONE_,
    stack: REF LinkStack_NIL,
    sI: NAT_0,
    initialized: BOOL_FALSE,
    visitParity: BOOL_FALSE,
    visitInProgress: BOOL_FALSE];
    
  TM: TYPE~REF TreeManager;
    
  Create: PUBLIC PROC[zone: ZONE] RETURNS[TM]~{
    tm: TM ~ zone.NEW[TreeManager _ [z~zone]];
    RETURN [tm]};

  Initialize: PUBLIC PROC[tm: TM] ~{
    IF tm.initialized THEN Finalize[tm];
    tm.stack _ AllocStack[tm, stackIncr];
    tm.sI _ 0;
    tm.initialized _ TRUE};
    
  Reset: PUBLIC PROC[tm: TM]~{
    IF tm.initialized AND tm.stack.size > 2*stackIncr THEN
      tm.stack _ AllocStack[tm, stackIncr]};

  Finalize: PUBLIC PROC[tm: TM]~{
    tm.initialized _ FALSE;
    tm.stack _ NIL};

  AllocStack: PROC[tm: TM, size: NAT, forceNew: BOOL_FALSE]
      RETURNS[st: REF LinkStack] ~ {
    st _ IF forceNew THEN NIL ELSE tm.stack;
    IF st = NIL OR st.size < size THEN st _ (tm.z).NEW[LinkStack[size]]};

  ExpandStack: PROC[tm: TM]~{
    newStack: REF LinkStack ~ AllocStack[tm, tm.stack.size+stackIncr, TRUE];
    FOR i: NAT IN [0..tm.stack.size) DO newStack[i] _ tm.stack[i] ENDLOOP;
    tm.stack _ newStack};


  Zone: PUBLIC PROC[tm: TM] RETURNS[ZONE]~{RETURN [tm.z]};
  
  PushTree: PUBLIC PROC[tm: TM, v: Tree.Link]~{
    IF tm.sI >= tm.stack.size THEN ExpandStack[tm];
    tm.stack[tm.sI] _ v;  tm.sI _ tm.sI+1};

  PopTree: PUBLIC PROC[tm: TM] RETURNS[Tree.Link]~{
    RETURN [tm.stack[tm.sI_tm.sI-1]]};

  InsertTree: PUBLIC PROC[tm: TM, v: Tree.Link, n: NAT]~{
    i: NAT _ tm.sI;
    IF tm.sI >= tm.stack.size THEN ExpandStack[tm];
    tm.sI _ tm.sI+1;
    THROUGH [1 .. n) DO tm.stack[i] _ tm.stack[i-1]; i _ i-1 ENDLOOP;
    tm.stack[i] _ v};

  ExtractTree: PUBLIC PROC[tm: TM, n: NAT] RETURNS[v: Tree.Link] ~ {
    i: NAT _ tm.sI - n;
    v _ tm.stack[i];
    THROUGH [1 .. n) DO tm.stack[i] _ tm.stack[i+1]; i _ i+1 ENDLOOP;
    tm.sI _ tm.sI - 1;
    RETURN};


  MakeNode: PUBLIC PROC[tm: TM, name: Tree.NodeName, count: INTEGER]
      RETURNS[Tree.Link] ~ {
    PushNode[tm, name, count];  RETURN [PopTree[tm]]};

  PushNode: PUBLIC PROC[tm: TM, name: Tree.NodeName, count: INTEGER] = {
    nSons: NAT~count.ABS;
    node: Tree.Handle~(tm.z).NEW[Tree.Node[nSons]_[name~name, visited~tm.visitParity, son~]];
    IF count >= 0 THEN
      FOR i: Tree.SonId DECREASING IN [1..nSons] DO
        node.son[i] _ tm.stack[tm.sI_tm.sI-1] ENDLOOP
    ELSE
      FOR i: Tree.SonId IN [1..nSons] DO
        node.son[i] _ tm.stack[tm.sI_tm.sI-1] ENDLOOP;
    IF tm.sI >= tm.stack.size THEN ExpandStack[tm];
    tm.stack[tm.sI] _ node;  tm.sI _ tm.sI+1};


  SetInfo: PUBLIC PROC[tm: TM, info: Tree.Info]~{
    WITH tm.stack[tm.sI-1] SELECT FROM
      node: Tree.Handle => node.info _ info;
      ENDCASE => ERROR};

  SetAttr: PUBLIC PROC[tm: TM, attr: Tree.AttrId, value: BOOL]~{
    FOR node: Tree.Handle _ NARROW[tm.stack[tm.sI-1]], NARROW[node.son[1]] DO
      IF node.name # $locator THEN {
        node.attrs[attr] _ value; EXIT};
      ENDLOOP};

  SetExt: PUBLIC PROC[tm: TM, ext: Tree.Ext]~{
    FOR node: Tree.Handle _ NARROW[tm.stack[tm.sI-1]], NARROW[node.son[1]] DO
      IF node.name # $locator THEN {
        node.ext _ ext; EXIT};
      ENDLOOP};


  -- structure extraction

  GetName: PUBLIC PROC[t: Tree.Link] RETURNS[Tree.Name] ~ {
    RETURN [WITH t SELECT FROM
      name: Tree.Name => name,
      node: Tree.Handle =>
        IF node.name # $locator THEN ERROR ELSE GetName[node.son[1]],
      ENDCASE => ERROR]};

  GetNode: PUBLIC PROC[t: Tree.Link] RETURNS[Tree.Handle] ~ {
    RETURN [WITH t SELECT FROM
      node: Tree.Handle =>
        IF node.name # $locator THEN node ELSE GetNode[node.son[1]],
      ENDCASE => ERROR]};

  GetId: PUBLIC PROC[t: Tree.Link] RETURNS[Tree.Id] ~ {
    RETURN [WITH t SELECT FROM
      id: Tree.Id => id,
      node: Tree.Handle =>
        IF node.name # $locator THEN ERROR ELSE GetId[node.son[1]],
      ENDCASE => ERROR]};
 

 -- procedures for tree testing

  NSons: PUBLIC PROC[t: Tree.Link] RETURNS[NAT] ~ {
    RETURN [WITH t SELECT FROM
      node: Tree.Handle =>
        IF node.name # $locator THEN node.sonLimit-1 ELSE NSons[node.son[1]],
      ENDCASE => 0]};

  NthSon: PUBLIC PROC[t: Tree.Link, n: Tree.SonId] RETURNS[Tree.Link] ~ {
    RETURN [WITH t SELECT FROM
      node: Tree.Handle =>
        IF node.name # $locator THEN node.son[n] ELSE NthSon[node.son[1], n],
      ENDCASE => ERROR]};

  PutNthSon: PUBLIC PROC[t: Tree.Link, n: Tree.SonId, v: Tree.Link] ~ {
    WITH t SELECT FROM
      node: Tree.Handle =>
        IF node.name # $locator THEN node.son[n] _ v
        ELSE PutNthSon[node.son[1], n, v];
      ENDCASE => ERROR};

  OpName: PUBLIC PROC[t: Tree.Link] RETURNS[Tree.NodeName] ~ {
    RETURN [WITH t SELECT FROM
      node: Tree.Handle =>
        IF node.name # $locator THEN node.name ELSE OpName[node.son[1]],
      ENDCASE => $none]};

  GetAttr: PUBLIC PROC[t: Tree.Link, attr: Tree.AttrId] RETURNS[BOOL] ~ {
    RETURN [WITH t SELECT FROM
      node: Tree.Handle =>
        IF node.name # $locator THEN node.attrs[attr] ELSE GetAttr[node.son[1], attr],
      ENDCASE => ERROR]};

  PutAttr: PUBLIC PROC[t: Tree.Link, attr: Tree.AttrId, value: BOOL] ~ {
    WITH t SELECT FROM
      node: Tree.Handle =>
        IF node.name # $locator THEN node.attrs[attr] _ value
        ELSE PutAttr[node.son[1], attr, value];
      ENDCASE => ERROR};

  GetInfo: PUBLIC PROC[t: Tree.Link] RETURNS[Tree.Info] ~ {
    RETURN [WITH t SELECT FROM
      node: Tree.Handle => node.info,
      ENDCASE => ERROR]};

  PutInfo: PUBLIC PROC[t: Tree.Link, value: Tree.Info] ~ {
    WITH t SELECT FROM
      node: Tree.Handle => node.info _ value;
      ENDCASE => ERROR};


  GetExt: PUBLIC PROC[t: Tree.Link] RETURNS[Tree.Ext] ~ {
    RETURN [WITH t SELECT FROM
      node: Tree.Handle =>
        IF node.name # $locator THEN node.ext ELSE GetExt[node.son[1]],
      ENDCASE => ERROR]};

  PutExt: PUBLIC PROC[t: Tree.Link, ext: Tree.Ext] ~ {
    WITH t SELECT FROM
      node: Tree.Handle =>
        IF node.name # $locator THEN node.ext _ ext
        ELSE PutExt[node.son[1], ext];
      ENDCASE => ERROR};


  -- procedures for tree traversal

  ScanSons: PUBLIC PROC[root: Tree.Link, action: TreeOps.Scan]~{
    WITH root SELECT FROM
      node: Tree.Handle =>
	FOR i: Tree.SonId IN [1 .. node.sonLimit) DO action[node.son[i]] ENDLOOP;
      ENDCASE};

  SearchSons: PUBLIC PROC[root: Tree.Link, test: TreeOps.Test]~{
    WITH root SELECT FROM
      node: Tree.Handle =>
	FOR i: Tree.SonId IN [1 .. node.sonLimit) DO
	  IF test[node.son[i]] THEN EXIT
	  ENDLOOP;
      ENDCASE};

  UpdateSons: PUBLIC PROC[tm: TM, root: Tree.Link, map: TreeOps.Map]~{
    WITH root SELECT FROM
      node: Tree.Handle =>
	FOR i: Tree.SonId IN [1 .. node.sonLimit) DO
	  node.son[i] _ map[tm, node.son[i]]
	  ENDLOOP;
      ENDCASE};
  

  UpdateLeaves: PUBLIC PROC[tm: TM, root: Tree.Link, map: TreeOps.Map]
      RETURNS[v: Tree.Link] ~ {
    IF root = Tree.null THEN v _ Tree.null
    ELSE
      WITH root SELECT FROM
	node: Tree.Handle => {
	  FOR i: Tree.SonId IN [1 .. node.sonLimit) DO
	    node.son[i] _ map[tm, node.son[i]] ENDLOOP;
	  v _ root};
	ENDCASE => v _ map[tm, root];
    RETURN};


 -- procedures for synchronizing external tree walks
 
  StartVisit: PUBLIC PROC[tm: TM] RETURNS[mark: BOOL] ~ {
    IF tm.visitInProgress THEN ERROR;	-- attempted recursion
    RETURN [~tm.visitParity]};
    
  EndVisit: PUBLIC PROC[tm: TM] ~ {
    tm.visitInProgress _ FALSE;
    tm.visitParity _ ~tm.visitParity};
    

 -- cross-table tree manipulation

  CopyTree: PUBLIC PROC[tm: TM, root: Tree.Link, map: TreeOps.Map]
      RETURNS[v: Tree.Link] ~ {
    WITH root SELECT FROM
      sNode: Tree.Handle => {
	IF sNode = Tree.nullHandle THEN v _ Tree.null
	ELSE {
	  dNode: Tree.Handle ~ (tm.z).NEW[Tree.Node[NSons[sNode]] _ [
		name~sNode.name,
		attrs~sNode.attrs,
		visited~tm.visitParity,
		info~sNode.info,
		son~]];
	  FOR i: Tree.SonId IN [1..sNode.sonLimit) DO
	    dNode.son[i] _ map[tm, sNode.son[i]] ENDLOOP;
	  v _ dNode}};
      ENDCASE => v _ map[tm, root];
    RETURN};

  IdentityMap: PUBLIC TreeOps.Map~{
    RETURN [IF ISTYPE[t, Tree.Handle] THEN CopyTree[tm, t, IdentityMap] ELSE t]};

  }.