[ivy]<Satterthwaite>Mimosa>Attr3a.mesa!2

Attr3a.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Satterthwaite, June 6, 1986 1:51:13 pm PDT
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, SENull, ISENull, lG, lZ, typeANY, seType, ctxType, mdType],
SymbolOps: TYPE USING [CtxEntries, CtxLevel, DecodeType, 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
BaseType: PUBLIC PROC[type: Type] RETURNS[Type] = {
sei: CSEIndex = UnderType[type];
RETURN[
WITH t: seb[sei] SELECT FROM
subrange => BaseType[t.rangeType],
long, real => BaseType[t.rangeType],
ENDCASE => type]
};
CanonicalType: PUBLIC PROC[type: Type] RETURNS[Type] = {
sei: CSEIndex = UnderType[type];
RETURN[WITH t: seb[sei] SELECT FROM
subrange => CanonicalType[t.rangeType],
record =>
IF Bundling[sei] # 0
THEN CanonicalType[Unbundle[LOOPHOLE[sei, RecordSEIndex]]]
ELSE type,
ENDCASE => type]
};
TargetType: PUBLIC PROC[type: Type] RETURNS[target: Type] = {
sei: CSEIndex = UnderType[type];
RETURN[WITH t: seb[sei] SELECT FROM
subrange => TargetType[t.rangeType],
ENDCASE => type]
};
Unbundle: 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] = {
sei: CSEIndex = UnderType[type];
RETURN[WITH t: seb[sei] 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[UnderType[t.componentType], safe],
transfer => t.mode # port,
opaque => t.lengthKnown,
ENDCASE => TRUE]
};
Bundling: PUBLIC PROC[type: CSEIndex] RETURNS[nLevels: CARDINAL] = {
next: Type;
ctx: CTXIndex;
nLevels ← 0;
DO
IF type = SENull THEN EXIT;
WITH t: seb[type] SELECT FROM
record => {
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[type, RecordSEIndex]];
IF ~c.complete THEN EXIT};
ENDCASE;
IF CtxEntries[ctx] # 1 OR t.hints.variant THEN EXIT;
nLevels ← nLevels + 1;
next ← Unbundle[LOOPHOLE[type, RecordSEIndex]]};
ENDCASE => EXIT;
type ← UnderType[next];
ENDLOOP;
RETURN};
ComponentType: PUBLIC PROC[type: Type] RETURNS[BOOL] = {
sei: CSEIndex = UnderType[type];
RETURN[WITH t: seb[sei] SELECT FROM
mode, any, nil => FALSE,
record =>
IF t.hints.variant THEN
SELECT seb[P3.VariantUnionType[sei]].typeTag FROM -- force copying now
sequence => FALSE,
ENDCASE => TRUE
ELSE TRUE,
opaque => t.lengthKnown,
ENDCASE => TRUE]
};
IdentifiedType: PUBLIC PROC[type: Type] RETURNS[BOOL] = {
sei: CSEIndex = UnderType[type];
RETURN[WITH t: seb[sei] SELECT FROM
mode, definition, any, nil, union, sequence => FALSE,
record =>
IF t.hints.variant AND ~t.hints.comparable THEN
SELECT seb[P3.VariantUnionType[sei]].typeTag FROM -- force copying now
sequence => FALSE,
ENDCASE => TRUE
ELSE TRUE,
opaque => t.lengthKnown,
ENDCASE => TRUE]
};
IndexType: PUBLIC PROC[type: Type] RETURNS[BOOL] = {
sei: CSEIndex = UnderType[type];
RETURN[WITH t: seb[sei] 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] = {
sei: CSEIndex = UnderType[type];
RETURN[WITH t: seb[sei] SELECT FROM
mode, any, nil => FALSE,
opaque => t.lengthKnown,
ENDCASE => TRUE]
};
NullableType: PUBLIC PROC[type: Type] RETURNS[BOOL] = {
sei: CSEIndex = NormalType[type];
RETURN[WITH t: seb[sei] SELECT FROM
ref, transfer, arraydesc, zone => TRUE,
ENDCASE => FALSE]
};
OrderedType: PUBLIC PROC[type: Type] RETURNS[BOOL] = {
sei: CSEIndex = UnderType[type];
RETURN[WITH t: seb[sei] 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] = {
sei: CSEIndex = UnderType[type];
RETURN[WITH t: seb[sei] SELECT FROM
record => CtxLevel[t.fieldCtx] = lG,
ENDCASE => FALSE]
};
VarType: PUBLIC PROC[type: Type] RETURNS[BOOL] = {
sei: CSEIndex = NormalType[type];
RETURN[WITH t: seb[sei] SELECT FROM
ref => t.var,
ENDCASE => FALSE]
};
defaults
Default: PUBLIC PROC[type: Type] RETURNS[form: A.DefaultForm ← $none] = {
next: Type;
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 ← DecodeType[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 ← DecodeType[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[subType, P3.voidAttr]};
copy => P3.RPush[subType, IF v=Tree.Null THEN P3.voidAttr ELSE P3.UpdateTreeAttr[v]];
eval => v ← P3.Initialization[PopTree[], TargetType[subType]];
ENDLOOP;
RETURN};
DiscrimId: PROC[sei: ISEIndex] RETURNS[BOOL] = INLINE {
RETURN[CtxLevel[seb[sei].idCtx] = lZ AND TypeLink[sei] # SENull]};
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 ← DecodeType[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] = {
subType: CSEIndex = NormalType[type];
RETURN[WITH t: seb[subType] SELECT FROM
ref => UnderType[TypeRoot[t.refType]],
transfer => subType,
ENDCASE => typeANY]
};
}.