-- file Attr3a.mesa
-- last modified by Satterthwaite, March 24, 1983 1:03 pm

DIRECTORY
  A3: TYPE USING [DefaultForm, LhsMode],
  Alloc: TYPE USING [Notifier],
  P3: TYPE USING [
    phraseNP, voidAttr,
    CompleteRecord, CopyTree, Initialization, RPush, UpdateTreeAttr, VariantUnionType],
  Symbols: TYPE USING [
    Base, Type, ISEIndex, CSEIndex, RecordSEIndex, CTXIndex,
    nullType, ISENull, lG, lZ, typeANY, seType, ctxType, mdType],
  SymbolOps: TYPE USING [
    CtxEntries, FindExtension, NormalType, TypeLink, TypeRoot,
    UnderType, VisibleCtxEntries],
  Tree: TYPE USING [Base, Link, Null, Scan, treeType],
  TreeOps: TYPE USING [
    PushSe, PopTree, PushNode, PushProperList, PushTree, OpName, ScanList];

Attr3a: PROGRAM
    IMPORTS P3, SymbolOps, TreeOps
    EXPORTS A3 = {
  OPEN TreeOps, SymbolOps, Symbols, A: A3;

  tb: Tree.Base;	-- tree base address (local copy)
  seb: Symbols.Base;	-- se table base address (local copy)
  ctxb: Symbols.Base;	-- context table base address (local copy)
  mdb: Symbols.Base;	-- module table base address (local copy)

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


 -- type mappings

  CanonicalType: PUBLIC PROC [type: Type] RETURNS [CSEIndex] = {
    csei: CSEIndex = UnderType[type];
    RETURN [WITH t: seb[csei] SELECT FROM
      subrange => CanonicalType[t.rangeType],
      record =>
	IF Wrappings[csei] # 0
	  THEN CanonicalType[Unwrap[LOOPHOLE[csei, RecordSEIndex]]]
	  ELSE csei,
      ENDCASE => csei]};

  TargetType: PUBLIC PROC [type: Type] RETURNS [CSEIndex] = {
    csei: CSEIndex = UnderType[type];
    RETURN [WITH t: seb[csei] SELECT FROM
      subrange => TargetType[t.rangeType],
      ENDCASE => csei]};

  Unwrap: PUBLIC PROC [record: RecordSEIndex] RETURNS [Type] = {
    RETURN [seb[ctxb[seb[record].fieldCtx].seList].idType]};


 -- type predicates

  AccessMode: PUBLIC PROC [type: Type] RETURNS [A.LhsMode] = {
    nType: CSEIndex = NormalType[type];
    RETURN [WITH t: seb[nType] SELECT FROM
      ref => SELECT TRUE FROM
		t.readOnly => none,
		t.counted => counted,
		ENDCASE => uncounted,
      arraydesc => IF t.readOnly THEN none ELSE uncounted,
      relative => AccessMode[t.offsetType],
      ENDCASE => none]};

  AssignableType: PUBLIC PROC [type: Type, safe: BOOL] RETURNS [BOOL] = {
    csei: CSEIndex = UnderType[type];
    RETURN [WITH t: seb[csei] SELECT FROM
      mode, definition, any, nil, sequence => FALSE,
      record => t.hints.assignable AND (~safe OR ~t.hints.variant),
      union => --t.hints.assignable AND-- ~safe,
      array => AssignableType[t.componentType, safe],
      transfer => t.mode # port, 
      opaque => t.lengthKnown,
      ENDCASE => TRUE]};

  IdentifiedType: PUBLIC PROC [type: Type] RETURNS [BOOL] = {
    csei: CSEIndex = UnderType[type];
    RETURN [WITH t: seb[csei] SELECT FROM
      mode, definition, any, nil, union, sequence => FALSE,
      record => 
	IF t.hints.variant AND ~t.hints.comparable THEN
	  SELECT seb[P3.VariantUnionType[csei]].typeTag FROM	-- force copying now
	    sequence => FALSE,
	    ENDCASE => TRUE
	ELSE TRUE,
      opaque => t.lengthKnown,
      ENDCASE => TRUE]};

  IndexType: PUBLIC PROC [type: Type] RETURNS [BOOL] = {
    csei: CSEIndex = UnderType[type];
    RETURN [WITH t: seb[csei] SELECT FROM
      basic => t.ordered,
      enumerated => t.ordered,
      subrange => IndexType[t.rangeType],
      long =>  IndexType[t.rangeType],
      ENDCASE => FALSE]};

  NewableType: PUBLIC PROC [type: Type] RETURNS [BOOL] = {
    csei: CSEIndex = UnderType[type];
    RETURN [WITH t: seb[csei] SELECT FROM
      mode, any, nil => FALSE,
      opaque => t.lengthKnown,
      ENDCASE => TRUE]};

  NullableType: PUBLIC PROC [type: Type] RETURNS [BOOL] = {
    csei: CSEIndex = NormalType[type];
    RETURN [WITH t: seb[csei] SELECT FROM
      ref, transfer, arraydesc, zone => TRUE,
      ENDCASE => FALSE]};

  OrderedType: PUBLIC PROC [type: Type] RETURNS [BOOL] = {
    csei: CSEIndex = UnderType[type];
    RETURN [WITH t: seb[csei] SELECT FROM
      basic => t.ordered,
      enumerated => t.ordered,
      ref => t.ordered,
      relative => OrderedType[t.offsetType],
      subrange => OrderedType[t.rangeType],
      long, real => OrderedType[t.rangeType],
      ENDCASE => FALSE]};

  PermanentType: PUBLIC PROC [type: Type] RETURNS [BOOL] = {
    csei: CSEIndex = UnderType[type];
    RETURN [WITH t: seb[csei] SELECT FROM
      record => ctxb[t.fieldCtx].level = lG,
      ENDCASE => FALSE]};

  VarType: PUBLIC PROC [type: Type] RETURNS [BOOL] = {
    csei: CSEIndex = NormalType[type];
    RETURN [WITH t: seb[csei] SELECT FROM
      ref => t.var,
      ENDCASE => FALSE]};
     
     
  Wrappings: PUBLIC PROC [type: Type] RETURNS [nLevels: NAT ← 0] = {
    next: Type ← type;
    UNTIL next = nullType DO
      csei: CSEIndex = UnderType[next];
      WITH t: seb[csei] SELECT FROM
	record => {
	  ctx: CTXIndex;
	  IF ~t.hints.unifield THEN EXIT;
	  ctx ← t.fieldCtx;
	  WITH c: ctxb[ctx] SELECT FROM
	    included => {
	      IF t.hints.privateFields AND ~mdb[c.module].shared THEN EXIT;
	      IF ~c.complete THEN P3.CompleteRecord[LOOPHOLE[csei, RecordSEIndex]];
	      IF ~c.complete THEN EXIT};
	    ENDCASE;
	  IF CtxEntries[ctx] # 1 OR t.hints.variant THEN EXIT;
	  nLevels ← nLevels + 1;
	  next ← Unwrap[LOOPHOLE[csei, RecordSEIndex]]};
	ENDCASE => EXIT;
      ENDLOOP;
    RETURN};


 -- defaults

  Default: PUBLIC PROC [type: Type] RETURNS [form: A.DefaultForm] = {
    next: Type;
    form ← none;
    FOR s: Type ← type, next DO
      WITH se: seb[s] SELECT FROM
	id => {
	  sei: ISEIndex = LOOPHOLE[s];

	  TestOption: Tree.Scan = {
	    IF OpName[t] = void THEN {IF form = none THEN form ← void}
	    ELSE form ← nonVoid};

	  IF seb[sei].extended THEN {ScanList[FindExtension[sei].tree, TestOption]; EXIT};
	  next ← seb[sei].idInfo};
	cons =>
	  WITH t: se SELECT FROM
	    ref => {IF t.counted THEN form ← nonVoid; EXIT};
	    array => next ← t.componentType;
	    record => {IF t.hints.default THEN form ← nonVoid; EXIT};
	    transfer => {form ← nonVoid; EXIT};
	    long => next ← t.rangeType;
	    zone => {IF t.counted THEN form ← nonVoid; EXIT};
	    ENDCASE => EXIT;
	ENDCASE => ERROR;
      ENDLOOP;
    RETURN};

  DefaultInit: PUBLIC PROC [type: Type] RETURNS [v: Tree.Link] = {
    next: Type;
    subType: CSEIndex ← UnderType[type];
    recordTail: Tree.Link ← Tree.Null;
    tagId: ISEIndex ← ISENull;
    v ← Tree.Null;
    FOR s: Type ← type, next DO
      WITH se: seb[s] SELECT FROM
	id => {
	  sei: ISEIndex = LOOPHOLE[s];

	  CopyNonVoid: Tree.Scan = {
	    IF OpName[t] # void AND v = Tree.Null THEN v ← P3.CopyTree[t]};

	  SELECT TRUE FROM
	    (seb[sei].extended AND recordTail = Tree.Null) => {
	      ScanList[FindExtension[sei].tree, CopyNonVoid]; GO TO copy};
	    (DiscrimId[sei] AND tagId = ISENull) => tagId ← sei;
	    ENDCASE;
	  next ← seb[sei].idInfo};
	cons =>
	  WITH t: se SELECT FROM
	    ref =>
	      IF t.counted THEN {PushTree[Tree.Null]; PushNode[nil, 1]; GO TO eval}
	      ELSE GO TO none;
	    array =>
	      IF Default[t.componentType] = nonVoid THEN {
	        PushTree[Tree.Null]; PushNode[all, 1]; GO TO eval}
	      ELSE GO TO none;
	    record =>
	      IF t.hints.default OR recordTail # Tree.Null THEN {
		n: CARDINAL;
		P3.CompleteRecord[LOOPHOLE[s]];
		n ← VisibleCtxEntries[t.fieldCtx];
		FOR i: CARDINAL IN [1..n] DO
		  PushTree[IF i # n THEN Tree.Null ELSE recordTail] ENDLOOP;
		PushProperList[n];  recordTail ← Tree.Null;
		IF tagId = ISENull THEN {PushTree[Tree.Null]; PushNode[apply, -2]; GO TO eval}
		ELSE {
		  PushSe[tagId];  tagId ← ISENull;
		  PushNode[apply,-2];   recordTail ← PopTree[];
		  next ← TypeLink[s];  subType ← UnderType[next]}}
	      ELSE GO TO none;
	    transfer => {
	      PushTree[Tree.Null]; PushNode[nil, 1]; GO TO eval};
	    zone =>
	      IF t.counted THEN {PushTree[Tree.Null]; PushNode[nil, 1]; GO TO eval}
	      ELSE GO TO none;
	    long => next ← t.rangeType;
	    ENDCASE => GO TO none;
	ENDCASE => ERROR;
      REPEAT
	none => {v ← Tree.Null; P3.phraseNP ← none; P3.RPush[type, P3.voidAttr]};
	copy => P3.RPush[type, IF v=Tree.Null THEN P3.voidAttr ELSE P3.UpdateTreeAttr[v]];
	eval => v ← P3.Initialization[TargetType[type], PopTree[]];
      ENDLOOP;
    RETURN};

  DiscrimId: PROC [sei: ISEIndex] RETURNS [BOOL] = INLINE {
    RETURN [ctxb[seb[sei].idCtx].level = lZ AND TypeLink[sei] # nullType]};


  Voidable: PUBLIC PROC [type: Type] RETURNS [BOOL] = {
    next: Type;
    FOR s: Type ← type, next DO
      WITH se: seb[s] SELECT FROM
	id => {
	  sei: ISEIndex = LOOPHOLE[s];
	  IF seb[sei].extended THEN RETURN [VoidItem[FindExtension[sei].tree]];
	  next ← seb[sei].idInfo};
	cons =>
	  WITH t: se SELECT FROM
	    ref => RETURN [~t.counted];
	    array => next ← t.componentType;
	    record => RETURN [t.hints.voidable];
	    union => RETURN [t.hints.voidable];
	    long => next ← t.rangeType;
	    zone => RETURN [~t.counted];
	    ENDCASE => RETURN [TRUE];
	ENDCASE => ERROR;
      ENDLOOP};

  VoidItem: PUBLIC PROC [t: Tree.Link] RETURNS [void: BOOL] = {
    TestVoid: Tree.Scan = {IF OpName[t] = void THEN void ← TRUE};
    void ← FALSE;  ScanList[t, TestVoid];  RETURN};


  MarkedType: PUBLIC PROC [type: Type] RETURNS [CSEIndex] = {
    csei: CSEIndex = NormalType[type];
    RETURN [WITH t: seb[csei] SELECT FROM
      ref => UnderType[TypeRoot[t.refType]],
      transfer => csei,
      ENDCASE => typeANY]};
    
  }.