-- file Attr3b.mesa
-- last modified by Satterthwaite, February 24, 1983 3:13 pm
-- last modified by Donahue, 10-Dec-81 11:23:00

DIRECTORY
  A3: TYPE USING [AccessMode, CanonicalType, LhsMode, LifeTime],
  Alloc: TYPE USING [Notifier],
  ComData: TYPE USING [typeINTEGER, typeSTRING],
  P3: TYPE USING [phraseNP, RecordLhs, SetNP],
  P3S: TYPE USING [currentBody],
  Symbols: TYPE USING [
    Base, Type, ISEIndex, CSEIndex, ContextLevel, CTXIndex, CBTIndex,
    CSENull, CTXNull, CBTNull, lG, lZ, typeANY, bodyType, ctxType, seType],
  SymbolOps: TYPE USING [UnderType, XferMode],
  Tree: TYPE USING [Base, Index, Link, NullIndex, treeType],
  TreeOps: TYPE USING [GetInfo, ListLength, NthSon, OpName];

Attr3b: PROGRAM
    IMPORTS
      A3, P3, P3S, SymbolOps, TreeOps,
      dataPtr: ComData
    EXPORTS A3 = {
  OPEN SymbolOps, Symbols, TreeOps, A: A3;

  tb: Tree.Base;	-- tree base address (local copy)
  seb: Base;	-- se table base address (local copy)
  ctxb: Base;	-- context table base address (local copy)
  bb: Base;	-- body table base address (local copy)

  TreeNotify: PUBLIC Alloc.Notifier = {
    -- called by allocator whenever table area is repacked
    seb ← base[seType];  ctxb ← base[ctxType];
    bb ← base[bodyType];
    tb ← base[Tree.treeType]};


 -- tree manipulation utilities

  TypeForTree: PUBLIC PROC [t: Tree.Link] RETURNS [Type] = {
    -- N.B. assumes t evaluated by P3.TypeLink or P3.Exp
    RETURN [WITH t SELECT FROM
      symbol => index,
      subtree =>
        SELECT tb[index].name FROM
          cdot, discrimTC => TypeForTree[tb[index].son[2]],
          ENDCASE => tb[index].info,
      ENDCASE => typeANY]};
      
      
  InterfaceVar: PROC [t: Tree.Link] RETURNS [BOOL] = INLINE {
    RETURN [WITH t SELECT FROM
      symbol => (ctxb[seb[index].idCtx].ctxType = imported),
      ENDCASE => FALSE]};

  WritableRef: PROC [t: Tree.Link] RETURNS [A.LhsMode] = {
    P3.phraseNP ← P3.SetNP[P3.phraseNP];
    RETURN [A.AccessMode[A.CanonicalType[OperandType[t]]]]};

  VarLhsMode: ARRAY A.LhsMode OF A.LhsMode = [
    none: $none, uncounted: $counted, counted: $counted];

  OperandLhs: PUBLIC PROC [t: Tree.Link] RETURNS [A.LhsMode] = {
    WITH t SELECT FROM
      symbol => {
	sei: ISEIndex = index;
	ctx: CTXIndex = seb[sei].idCtx;
	level: ContextLevel;
	IF ctx = CTXNull THEN level ← lZ
	ELSE {
	  ctxb[ctx].varUpdated ← TRUE;
	  IF (level ← ctxb[ctx].level) < P3S.currentBody.level THEN
	    P3.phraseNP ← P3.SetNP[P3.phraseNP]};
	P3.RecordLhs[sei];
	RETURN [SELECT TRUE FROM
	   seb[sei].immutable => $none,
	   (level = lG) => $counted,
	   ENDCASE => $uncounted]};
      subtree => {
	node: Tree.Index = index;
	RETURN [IF node = Tree.NullIndex THEN $none ELSE
	  SELECT tb[node].name FROM
	    $dot =>
	      WITH tb[node].son[2] SELECT FROM
		symbol =>
		  SELECT TRUE FROM
		    seb[index].immutable => $none,
		    (ctxb[seb[index].idCtx].level = lG) =>
		      VarLhsMode[WritableRef[tb[node].son[1]]],
		    ENDCASE => WritableRef[tb[node].son[1]],
		ENDCASE => none,
	    $uparrow =>
	      IF InterfaceVar[tb[node].son[1]]
		THEN VarLhsMode[WritableRef[tb[node].son[1]]]
		ELSE WritableRef[tb[node].son[1]],
	    $dindex => WritableRef[tb[node].son[1]],
	    $reloc => WritableRef[tb[node].son[2]],
	    $dollar =>
	      WITH tb[node].son[2] SELECT FROM
		symbol =>
		  IF ~seb[index].immutable
		    THEN OperandLhs[tb[node].son[1]]
		    ELSE $none,
		ENDCASE => $none,
	    $index, $seqindex, $loophole, $cast, $openx, $pad, $chop =>
	      OperandLhs[tb[node].son[1]],
	    $cdot => OperandLhs[tb[node].son[2]],
	    $apply => IF ListLength[tb[node].son[1]] = 1 THEN $uncounted ELSE $none,
	    ENDCASE => $none]};
      ENDCASE => RETURN [$none]};

  OperandInline: PUBLIC PROC [t: Tree.Link] RETURNS [BOOL] = {
    bti: CBTIndex;
    RETURN [SELECT XferMode[OperandType[t]] FROM
      $proc => (bti←BodyForTree[t]) # CBTNull AND bb[bti].inline,
      ENDCASE => FALSE]};

  OperandLevel: PUBLIC PROC [t: Tree.Link] RETURNS [level: A.LifeTime] = {
    SELECT OpName[t] FROM
      $cdot, $nil => level ← $global;
      ENDCASE => {
	bti: CBTIndex = BodyForTree[t];
	level ← SELECT TRUE FROM
	  (bti = CBTNull) => $unknown,
	  (bb[bti].level <= lG+1) => $global,
	  ENDCASE => $local};
    RETURN};

  OperandInternal: PUBLIC PROC [t: Tree.Link] RETURNS [BOOL] = {
    WITH t SELECT FROM
      symbol => {
	bti: CBTIndex = BodyForTree[t];
	RETURN [bti # CBTNull AND bb[bti].internal]};
      subtree =>
	RETURN [SELECT OpName[t] FROM
	  $dot, $cdot, $assignx => OperandInternal[NthSon[t, 2]],
	  $ifx => OperandInternal[NthSon[t, 2]] OR OperandInternal[NthSon[t, 3]],
	  ENDCASE => FALSE];	-- should check casex, bindx also
      ENDCASE => RETURN [FALSE]};


  OperandType: PUBLIC PROC [t: Tree.Link] RETURNS [CSEIndex] = {
    RETURN [WITH e:t SELECT FROM
      symbol => UnderType[seb[e.index].idType],
      literal =>
	WITH e.index SELECT FROM
	  string => dataPtr.typeSTRING,
	  ENDCASE => dataPtr.typeINTEGER,
      subtree => tb[e.index].info,
      ENDCASE => CSENull]};


  LongPath: PUBLIC PROC [t: Tree.Link] RETURNS [long: BOOL] = {
    WITH t SELECT FROM
      subtree => {
	node: Tree.Index = index;
	long ← IF node = Tree.NullIndex
	  THEN FALSE
	  ELSE SELECT tb[node].name FROM
	    $loophole, $cast, $openx, $pad, $chop => LongPath[tb[node].son[1]],
	    -- $dot, $uparrow, $dindex, $reloc, $seqindex, $dollar, $index => --
	    ENDCASE => tb[node].attr2};
      ENDCASE => long ← FALSE;
    RETURN};


  BodyForTree: PUBLIC PROC [t: Tree.Link] RETURNS [CBTIndex] = {
    node: Tree.Index;
    WITH t SELECT FROM
      symbol => {
	sei: ISEIndex = index;
	SELECT TRUE FROM
	  seb[sei].mark4 =>
	    RETURN [IF seb[sei].constant THEN seb[sei].idInfo ELSE CBTNull]; 
	  seb[sei].immutable => {
	    node ← seb[sei].idValue;
	    IF OpName[tb[node].son[3]] = $body THEN RETURN [GetInfo[tb[node].son[3]]]};
	  ENDCASE};
      subtree => {
	node ← index;
	SELECT tb[node].name FROM
	  $cdot, $dot, $dollar => RETURN [BodyForTree[tb[node].son[2]]];
	  ENDCASE};
      ENDCASE;
    RETURN [CBTNull]};
    
  }.