-- file SMValImpl.mesa
-- last edited by Satterthwaite, August 5, 1983 5:16 pm

DIRECTORY
  SMOps: TYPE USING [MS],
  SMTree: TYPE Tree USING [
    BindOp, Handle, Id, Link, Name, NodeName, SonId, null, nullHandle],
  SMTreeOps: TYPE --TreeOps-- USING [
    Scan, TM, EndVisit, GetExt, GetName, NSons, NthSon, OpName, PutExt, ScanSons, StartVisit],
  SMVal: TYPE USING [];
  
SMValImpl: CEDAR PROGRAM
    IMPORTS SMTreeOps
    EXPORTS SMVal ~ {
  OPEN Tree~~SMTree, TreeOps~~SMTreeOps;

     
 -- note: to expedite Id handling, these procs know about Tree.Node internals
 
  Binding: PUBLIC PROC[t: Tree.Link] RETURNS[BOOL] ~ {
    RETURN [TreeOps.OpName[t] IN Tree.BindOp]};
    
  BtoD: PUBLIC PROC[binding: Tree.Link] RETURNS[Tree.Handle] ~ {
    b: Tree.Handle ~ NARROW[binding];
    RETURN [NARROW[b.son[1]]]};
    
  BtoG: PUBLIC PROC[binding: Tree.Link] RETURNS[Tree.Handle] ~ {
    b: Tree.Handle ~ NARROW[binding];
    son2: Tree.Handle ~ NARROW[b.son[2]];
    RETURN [SELECT son2.name FROM
        $group => son2,
        $let => NARROW[son2.son[2]],
        ENDCASE => ERROR]
      };
    

 -- next two auxiliary procs duplicated from SMEvalImpl
 
  DBtoD: PROC[db: Tree.Handle] RETURNS[Tree.Handle] ~ INLINE {
    RETURN [IF db.name = $decl THEN db ELSE NARROW[db.son[1]]]};
    
  DBtoG: PROC[db: Tree.Handle] RETURNS[group: Tree.Handle] ~ {
    IF db.name IN Tree.BindOp THEN {
      node: Tree.Handle ~ NARROW[db.son[2]];
      SELECT node.name FROM
        $group => group _ node;
        $let => group _ NARROW[node.son[2]];
        ENDCASE => ERROR;
      }
    ELSE group _ Tree.nullHandle;
    RETURN};
    
    
  IdName: PUBLIC PROC[id: Tree.Id] RETURNS[Tree.Name] ~ {
    RETURN [TreeOps.GetName[TreeOps.NthSon[DBtoD[id.db].son[id.p], 1]]]};
    
  IdType: PUBLIC PROC[id: Tree.Id] RETURNS[Tree.Link] ~ {
    RETURN [TreeOps.NthSon[DBtoD[id.db].son[id.p], 2]]};
    
  IdValue: PUBLIC PROC[id: Tree.Id] RETURNS[Tree.Link] ~ {
    RETURN [SELECT id.db.name FROM
      $decl =>  Tree.null,	-- id?  See VisitNodes
      IN Tree.BindOp => DBtoG[id.db].son[id.p],
      ENDCASE => Tree.null]
    };
      

 -- attribute retrieval (after Eval)
 
  Select: PUBLIC PROC[binding: Tree.Link, index: Tree.Name] RETURNS[Tree.Link] ~ {
    d: Tree.Link ~ BtoD[binding];
    g: Tree.Link ~ BtoG[binding];
    FOR i: NAT IN [1 .. TreeOps.NSons[d]] DO
      son: Tree.Link ~ TreeOps.NthSon[d, i];
      IF TreeOps.GetName[TreeOps.NthSon[son, 1]] = index THEN
	RETURN[TreeOps.NthSon[g, i]];
      ENDLOOP;
    RETURN[Tree.null]};
    

  ValOf: PUBLIC PROC[t: Tree.Link] RETURNS[Tree.Link] ~ {
    RETURN [WITH t SELECT FROM
      id: Tree.Id =>
        IF id.db.name IN Tree.BindOp
          THEN ValOf[DBtoG[id.db].son[id.p]]
          ELSE id,
      ENDCASE => t]};
      
  ValOfNthSon: PUBLIC PROC[t: Tree.Link, n: Tree.SonId] RETURNS[Tree.Link] ~ {
    RETURN [ValOf[TreeOps.NthSon[t, n]]]};
 

 -- enumeration
 
  VisitNodes: PUBLIC PROC[
      tm: TreeOps.TM, root: Tree.Link, proc: PROC[node, parent: Tree.Link]] ~ {
    mark: BOOL ~ tm.StartVisit[];
    parent: Tree.Link _ Tree.null;
     
    Visit: TreeOps.Scan ~ {
      WITH t SELECT FROM
        node: Tree.Handle =>
          IF node.visited # mark AND node.name # $lambda THEN {
            saveParent: Tree.Link ~ parent;
            node.visited _ mark;
	    parent _ node;
	    TreeOps.ScanSons[node, Visit];	-- postorder
            proc[node, saveParent]};
        id: Tree.Id => Visit[IdValue[id]];
        ENDCASE => NULL;
      };
     
    Visit[root];
    tm.EndVisit};
     
  ResetVisits: PUBLIC PROC[ms: SMOps.MS] ~ {
    -- for disaster recovery
    mark: BOOL;
    
    Unmark: TreeOps.Scan ~ {
      WITH t SELECT FROM
        node: Tree.Handle => {
          TreeOps.ScanSons[node, Unmark];
          node.visited _ mark};
        ENDCASE;
      };
        
    (ms.tm).EndVisit;	-- ok as no-op
    mark _ (ms.tm).StartVisit[];
    Unmark[ms.val];
    (ms.tm).EndVisit};
    
    
 -- lambda decomposition
 
  OuterBody: PUBLIC PROC[t: Tree.Link] RETURNS[formals, body: Tree.Link] ~ {
    RETURN (WITH ValOf[t] SELECT FROM
      node: Tree.Handle =>
        SELECT TreeOps.OpName[t] FROM
          $lambda => [TreeOps.NthSon[node, 1], TreeOps.NthSon[node, 3]],
          $let =>  APPLY[OuterBody, TreeOps.NthSon[node, 2]],
          ENDCASE => [Tree.null, node],
      ENDCASE => [Tree.null, t])};
      
 
 -- extension management (indirect to parse tree, after Eval)    

  GetExtFromParse: PUBLIC PROC[link: Tree.Link] RETURNS[Tree.Link] ~ {
    parseLink: Tree.Link ~
      (IF link = Tree.null THEN Tree.null ELSE NARROW[TreeOps.GetExt[link]]);
    RETURN[WITH parseLink SELECT FROM
      parseNode: Tree.Handle => TreeOps.GetExt[parseNode],
      ENDCASE => Tree.null]};

  PutExtInParse: PUBLIC PROC[link: Tree.Link, ext: Tree.Link] ~ {
    parseLink: Tree.Link ~ NARROW[TreeOps.GetExt[link]];
    TreeOps.PutExt[parseLink, ext]};

  }.