-- file Pass3V.Mesa
-- last modified by Satterthwaite, September 17, 1982 2:19 pm
DIRECTORY
Alloc: TYPE USING [Notifier],
ComData: TYPE USING [seAnon, textIndex, typeBOOL],
Copier: TYPE USING [CopyUnion],
Log: TYPE USING [Error, ErrorHti, ErrorSei, ErrorTree, Warning],
P3: TYPE USING [
Attr, NarrowOp, NPUse, phraseNP,
BaseTree, CanonicalType, EnterType, Exp, FindSe, FirstId, ForceType, LongPath,
MarkedType, Narrowing, OpenPointer, OperandType, PopCtx,
PushCtx, PushHtCtx, PushRecordCtx, RAttr, Rhs, RPop, RPush, RType, Scope,
SealRefStack, SearchCtxList, TargetType, TopCtx, TypeForTree, UnsealRefStack,
UpdateTreeAttr, VoidExp],
P3S: TYPE USING [ImplicitInfo, implicit, implicitRecord, safety],
Symbols: TYPE USING [
Base, HTIndex, SEIndex, ISEIndex, CSEIndex, RecordSEIndex, CTXIndex,
HTNull, SENull, ISENull, CSENull, CTXNull, typeANY, typeTYPE, seType, ctxType],
SymbolOps: TYPE USING [NextSe, NormalType, RCType, ReferentType, TypeForm, UnderType],
Tree: TYPE USING [Base, Index, Link, Map, Null, Scan, treeType],
TreeOps: TYPE USING [
GetHash, GetNode, ListHead, ListTail, OpName, PopTree, PushTree, PushNode, PushSe,
ScanList, SetAttr, SetInfo, UpdateList];
Pass3V: PROGRAM
IMPORTS
Copier, Log, P3, P3S, SymbolOps, TreeOps,
dataPtr: ComData
EXPORTS P3 = {
OPEN SymbolOps, P3, Symbols, TreeOps;
-- tables defining the current symbol table
tb: Tree.Base; -- tree base
seb: Symbols.Base; -- se table
ctxb: Symbols.Base; -- context table
VRNotify: PUBLIC Alloc.Notifier = {
-- called whenever the main symbol table is repacked
tb ← base[Tree.treeType]; seb ← base[seType]; ctxb ← base[ctxType]};
-- finding union and discriminated types
-- N. B. the following two entries cannot assume well-formed type links
VariantUnionType: PUBLIC PROC [type: SEIndex] RETURNS [CSEIndex] = {
rType: CSEIndex = ConsType[type];
RETURN [WITH seb[rType] SELECT FROM
record =>
IF hints.variant
THEN ConsType[TypeForSe[UnionField[LOOPHOLE[rType, RecordSEIndex]]]]
ELSE typeANY,
ENDCASE => typeANY]};
SelectVariantType: PUBLIC PROC [type: SEIndex, tag: HTIndex] RETURNS [sei: ISEIndex] = {
matched: BOOLEAN;
vType: CSEIndex = VariantUnionType[type];
WITH seb[vType] SELECT FROM
union => [matched, sei] ← SearchCtxList[tag, caseCtx];
ENDCASE => matched ← FALSE;
IF ~matched THEN sei ← ISENull;
RETURN};
SequenceField: PUBLIC PROC [rSei: RecordSEIndex] RETURNS [ISEIndex] = {
sei: ISEIndex = UnionField[rSei];
RETURN [IF TypeForm[seb[sei].idType] = sequence THEN sei ELSE ISENull]};
-- auxiliary procedures (for avoiding UnderType when potentially unsafe)
UnionField: PROC [rSei: RecordSEIndex] RETURNS [ISEIndex] = {
sei, root, next: ISEIndex;
ctx: CTXIndex = seb[rSei].fieldCtx;
IF ctxb[ctx].ctxType = simple THEN
FOR sei ← ctxb[ctx].seList, next UNTIL sei = ISENull DO
next ← NextSe[sei];
IF next = ISENull THEN RETURN [sei];
ENDLOOP
ELSE { -- defined in another module, UnderType is safe
repeated: BOOLEAN ← FALSE;
DO
sei ← root ← ctxb[ctx].seList;
DO
IF sei = ISENull THEN EXIT;
SELECT TypeForm[seb[sei].idType] FROM
union, sequence => RETURN [sei];
ENDCASE;
IF (sei ← NextSe[sei]) = root THEN EXIT;
ENDLOOP;
IF repeated THEN EXIT;
Copier.CopyUnion[seb[rSei].fieldCtx]; repeated ← TRUE;
ENDLOOP};
RETURN [dataPtr.seAnon]};
ResolveId: PROC [hti: HTIndex, ctx: CTXIndex] RETURNS [sei: ISEIndex] = {
currentCtx: CTXIndex = TopCtx[];
IF ctx = currentCtx THEN sei ← FindSe[hti].symbol
ELSE {PopCtx[]; sei ← ResolveId[hti, ctx]; PushCtx[currentCtx]};
RETURN};
TypeForSe: PROC [sei: ISEIndex] RETURNS [type: SEIndex] = INLINE {
node: Tree.Index;
t: Tree.Link;
IF seb[sei].mark3 THEN RETURN [seb[sei].idType];
node ← seb[sei].idValue;
IF tb[node].name # decl THEN RETURN [typeTYPE];
t ← tb[node].son[2];
type ← WITH t SELECT FROM
hash => ResolveId[index, seb[sei].idCtx],
symbol => index,
subtree => tb[index].info,
ENDCASE => typeANY;
RETURN};
ConsType: PROC [type: SEIndex] RETURNS [CSEIndex] = {
WITH se: seb[type] SELECT FROM
id =>
IF se.mark3 THEN
RETURN [IF se.idType # typeTYPE THEN typeANY ELSE ConsType[se.idInfo]]
ELSE {
node: Tree.Index = se.idValue;
RETURN [IF tb[node].name # typedecl
THEN typeANY
ELSE ConsType[ResolveTreeType[tb[node].son[2], se.idCtx]]]};
cons => RETURN [LOOPHOLE[type, CSEIndex]];
ENDCASE => ERROR};
ResolveTreeType: PROC [t: Tree.Link, ctx: CTXIndex] RETURNS [type: SEIndex] = {
WITH t SELECT FROM
hash => type ← ResolveId[index, ctx];
symbol => type ← index;
subtree => {
node: Tree.Index = index;
type ← IF tb[node].info # SENull
THEN tb[node].info
ELSE
SELECT tb[node].name FROM
discrimTC =>
WITH tb[node].son[2] SELECT FROM
hash => SelectVariantType[ResolveTreeType[tb[node].son[1], ctx], index],
ENDCASE => ERROR,
ENDCASE => ERROR};
ENDCASE => ERROR;
RETURN};
-- type discrimination
DiscriminatedType: PUBLIC PROC [baseType: CSEIndex, t: Tree.Link]
RETURNS [type: CSEIndex] = {
IF t = Tree.Null THEN type ← P3S.implicitRecord
ELSE
WITH t SELECT FROM
subtree => {
node: Tree.Index = index;
temp: Tree.Link;
SELECT tb[node].name FROM
union => {
type ← WITH tb[node].son[1] SELECT FROM symbol => UnderType[index], ENDCASE => ERROR;
WITH seb[type] SELECT FROM
record =>
IF hints.variant AND tb[node].son[2] # Tree.Null
AND (temp←ListTail[tb[node].son[2]]) # Tree.Null THEN
type ← DiscriminatedType[type, temp];
ENDCASE => ERROR};
dollar => type ← OperandType[tb[node].son[1]];
dot => {
subType: CSEIndex = NormalType[OperandType[tb[node].son[1]]];
type ← WITH seb[subType] SELECT FROM ref => UnderType[refType], ENDCASE => ERROR};
assignx => type ← DiscriminatedType[baseType, tb[node].son[2]];
ENDCASE => type ← baseType};
ENDCASE => type ← baseType;
RETURN};
-- binding of variant records
Discrimination: PUBLIC PROC [node: Tree.Index, selection: Tree.Map] = {
OPEN tb[node];
copy: BOOLEAN = (OpName[ListHead[son[3]]] = ditem);
type, subType: CSEIndex;
vCtx: CTXIndex;
base, discBase: Tree.Link;
attr: Attr;
entryNP: NPUse ← none;
unreachable: BOOLEAN ← FALSE;
BindError: PROC = {
IF son[2] # Tree.Null THEN son[2] ← VoidExp[son[2]]; vCtx ← CTXNull};
PushCommonCtx: PROC = {
SELECT TRUE FROM
copy OR (seb[type].typeTag # record) => PushCtx[CTXNull];
(baseId = HTNull) => PushRecordCtx[LOOPHOLE[type], base, indirect];
ENDCASE => PushHtCtx[baseId, base, indirect]};
BindItem: Tree.Scan = {
subNode: Tree.Index = GetNode[t];
saveIndex: CARDINAL = dataPtr.textIndex;
IF tb[subNode].name = ditem THEN {
declNode: Tree.Index = GetNode[tb[subNode].son[1]];
declType: CSEIndex;
Item: Tree.Map = {phraseNP ← entryNP; v ← selection[t]};
op: NarrowOp;
dataPtr.textIndex ← tb[declNode].info;
IF unreachable THEN {Log.Warning[unreachable]; unreachable ← FALSE};
Scope[subNode, Item];
declType ← UnderType[TypeForTree[tb[declNode].son[2]]];
op ← Narrowing[subType, declType];
SELECT TRUE FROM
~copy => Log.Error[discrimForm];
op.error => Log.ErrorSei[typeClash, FirstId[declNode]];
op.computed => Log.ErrorTree[missingBinding, base];
op.unImpl => Log.Warning[unimplemented];
~(op.rtTest OR op.tagTest) => unreachable ← TRUE;
ENDCASE;
tb[subNode].attr1 ← op.indirect;
IF (tb[subNode].attr2 ← op.rtTest) THEN EnterType[MarkedType[declType]];
tb[subNode].attr3 ← op.tagTest}
ELSE {
vType: CSEIndex;
dataPtr.textIndex ← tb[subNode].info;
IF copy THEN {Log.Error[discrimForm]; attr3 ← FALSE};
[tb[subNode].son[1], vType] ← BindTest[tb[subNode].son[1], vCtx];
IF vType = typeANY THEN PushCommonCtx[]
ELSE {
WITH discBase SELECT FROM
subtree => tb[index].info ← vType;
ENDCASE => ERROR;
IF baseId = HTNull THEN PushRecordCtx[LOOPHOLE[vType], discBase, FALSE]
ELSE PushHtCtx[baseId, discBase, FALSE]};
phraseNP ← entryNP;
tb[subNode].son[2] ← selection[tb[subNode].son[2]];
PopCtx[];
tb[subNode].attr1 ← TRUE};
dataPtr.textIndex ← saveIndex};
saveImplicit: P3S.ImplicitInfo = P3S.implicit;
idNode: Tree.Index = GetNode[son[1]];
baseId: HTIndex = GetHash[tb[idNode].son[1]];
indirect: BOOLEAN;
SealRefStack[];
base ← tb[idNode].son[2] ← Exp[tb[idNode].son[2], typeANY];
type ← RType[]; attr ← RAttr[]; RPop[];
UnsealRefStack[];
subType ← CanonicalType[type];
IF subType # type THEN tb[idNode].son[2] ← ForceType[tb[idNode].son[2], subType];
type ← NormalType[subType];
P3S.implicit ← [tree: base, type: subType, attr: attr];
IF (attr3 ← copy) THEN {
P3S.implicit.attr.noAssign ← P3S.implicit.attr.noXfer ← TRUE;
SELECT TypeForm[type] FROM
ref => {
attr2 ← (TypeForm[ReferentType[type]] = any);
indirect ← TRUE};
transfer => {attr2 ← TRUE; indirect ← FALSE};
ENDCASE => {attr2 ← FALSE; indirect ← FALSE};
IF baseId # HTNull THEN Log.Error[discrimForm]}
ELSE {
long: BOOLEAN;
WITH t: seb[type] SELECT FROM
ref => {
indirect ← TRUE;
[base, type] ← OpenPointer[base, subType];
subType ← OperandType[base]; long ← seb[subType].typeTag = long};
ENDCASE => {indirect ← FALSE; long ← LongPath[base]};
IF P3S.safety = checked AND RCType[type] # none THEN
Log.ErrorTree[unsafeSelection, base];
WITH seb[type] SELECT FROM
record => {
tb[idNode].son[2] ← base ← BaseTree[base, subType];
IF hints.variant THEN {
uType: CSEIndex = VariantUnionType[type];
WITH u: seb[uType] SELECT FROM
union => {
tagType: CSEIndex = UnderType[seb[u.tagSei].idType];
vCtx ← u.caseCtx;
IF son[2] = Tree.Null THEN {
IF ~u.controlled THEN Log.ErrorTree[missingBinding, base];
[] ← UpdateTreeAttr[base]; entryNP ← phraseNP;
PushTree[base]; PushSe[u.tagSei];
PushNode[IF indirect THEN dot ELSE dollar, 2];
SetInfo[tagType]; SetAttr[2, long]; son[2] ← PopTree[]}
ELSE {
IF u.controlled THEN Log.ErrorTree[spuriousBinding, son[2]];
PushCommonCtx[];
son[2] ← Rhs[son[2], TargetType[tagType]];
entryNP ← phraseNP; RPop[];
PopCtx[]}};
ENDCASE => {Log.Error[noAccess]; BindError[]}}
ELSE {Log.ErrorTree[noVariants, tb[idNode].son[2]]; BindError[]};
PushTree[base];
IF indirect THEN {PushNode[uparrow, 1]; SetAttr[2, long]}
ELSE PushNode[cast, 1];
discBase ← PopTree[]};
ENDCASE => {
Log.ErrorTree[noVariants, tb[idNode].son[2]]; BindError[];
discBase ← Tree.Null}};
attr1 ← indirect;
ScanList[son[3], BindItem];
PushCommonCtx[]; phraseNP ← entryNP; son[4] ← selection[son[4]]; PopCtx[];
RPush[CSENull, attr];
P3S.implicit ← saveImplicit};
BindTest: PROC [t: Tree.Link, vCtx: CTXIndex]
RETURNS [val: Tree.Link, vType: CSEIndex] = {
mixed: BOOLEAN ← FALSE;
TestItem: Tree.Map = {
WITH t SELECT FROM
subtree => {
subNode: Tree.Index = index;
SELECT tb[subNode].name FROM
relE =>
WITH tb[subNode].son[2] SELECT FROM
hash => {
iType: ISEIndex;
uType: CSEIndex;
found: BOOLEAN;
[found, iType] ← SearchCtxList[index, vCtx];
IF found THEN {
uType ← UnderType[iType];
tb[subNode].son[2] ← [symbol[index: iType]];
SELECT vType FROM
uType => NULL;
typeANY => vType ← uType;
ENDCASE => mixed ← TRUE}
ELSE IF vCtx # CTXNull THEN Log.ErrorHti[unknownVariant, index];
tb[subNode].info ← dataPtr.typeBOOL;
tb[subNode].attr1 ← tb[subNode].attr2 ← FALSE;
v ← t};
ENDCASE => {
v ← Rhs[t, dataPtr.typeBOOL]; RPop[];
Log.ErrorTree[nonVariantLabel, t]};
ENDCASE => {
v ← Rhs[t, dataPtr.typeBOOL]; RPop[];
Log.ErrorTree[nonVariantLabel, t]}};
ENDCASE => ERROR;
RETURN};
vType ← typeANY; val ← UpdateList[t, TestItem];
IF mixed THEN vType ← typeANY;
RETURN};
}.