[ivy]<Satterthwaite>Mimosa>Pass3I.mesa!6

Pass3I.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Satterthwaite, June 25, 1986 3:51:06 pm PDT
Donahue, 8-Dec-81 15:29:30
Russ Atkinson (RRA) March 6, 1985 10:42:03 pm PST
DIRECTORY
A3: TYPE USING [LongPath, MarkedType, OperandType, PermanentType, TypeForTree, VarType],
Alloc: TYPE USING [Notifier, AddNotify, DropNotify],
ComData: TYPE USING [interface, moduleCtx, seAnon, switches, table, textIndex, typeAtomRecord],
Copier: TYPE USING [CompleteContext, Delink, SearchFileCtx],
Log: TYPE USING [ErrorHti, ErrorSei, ErrorTree, ErrorTreeOp, WarningSei],
P3: TYPE USING [Attr, fullAttr, voidAttr, mark, MergeNP, phraseNP, And, Exp, FirstId, InterfaceCtx, ItemType, MakeRefType, ResolveType, ResolveValue, RPop, RPush, RType, SetDefaultImport, SetType, VariantUnionType, VoidExp],
P3S: TYPE USING [currentBody, currentScope, safety],
SourceMap: TYPE USING [Loc],
Symbols: TYPE USING [seType, ctxType, mdType, Base, CTXRecord, ExtensionType, MDIndex, HTIndex, Type, ISEIndex, CSEIndex, ArraySEIndex, RecordSEIndex, CTXIndex, IncludedCTXIndex, Closure, HTNull, nullType, ISENull, CSENull, RecordSENull, CTXNull, IncludedCTXNull, lG, lZ, FirstStandardCtx, LastStandardCtx, typeTYPE, typeANY],
SymbolOps: TYPE USING [ArgCtx, ConstantId, CtxLevel, DecodeCard, DecodeTreeIndex, DecodeType, EncodeCard, EncodeTreeIndex, EnterExtension, FindExtension, FirstCtxSe, FromBti, LinkMode, NextSe, NormalType, RCType, RecordRoot, ReferentType, SearchContext, SetSeLink, ToType, TypeForm, TypeLink, TypeRoot, UnderType],
SymLiteralOps: TYPE USING [EnterAtom, EnterType],
Tree: TYPE USING [Base, Index, Link, Map, Scan, Test, Null, nullIndex, treeType],
TreeOps: TYPE USING [CopyTree, FreeTree, GetHash, GetNode, GetSe, GetTag, ListLength, MarkShared, NthSon, OpName, PopTree, PushTree, PushNode, ScanList, ScanSons, SearchList, SetAttr, SetInfo, ToLoc, UpdateList, UpdateLeaves];
Pass3I: PROGRAM
IMPORTS A3, Alloc, Copier, Log, P3, P3S, SymLiteralOps, SymbolOps, TreeOps, dataPtr: ComData
EXPORTS P3 = {
OPEN SymbolOps, A3, P3, Symbols, TreeOps;
uninitialized variable processing
RefItem: TYPE = RECORD[kind: {seal, rhs, lhs}, sei: ISEIndex];
RefSeal: RefItem = [kind:seal, sei:ISENull];
RefSequence: TYPE = RECORD[SEQUENCE length: CARDINAL OF RefItem];
RefStack: TYPE = REF RefSequence;
refStack: RefStack;
refIndex: CARDINAL;
AdjustRefStack: PROC[n: CARDINAL] = {
oldStack: RefStack ← refStack;
refStack ← NEW[RefSequence[n]];
FOR i: CARDINAL IN [0..refIndex) DO refStack[i] ← oldStack[i] ENDLOOP;
oldStack ← NIL};
RecordMention: PUBLIC PROC[sei: ISEIndex] = {
IF dataPtr.switches['u] AND (DecodeCard[seb[sei].idInfo] = 0 AND ~seb[sei].mark4) THEN {
IF refIndex >= refStack.length THEN AdjustRefStack[refStack.length + 8];
refStack[refIndex] ← [kind:rhs, sei:sei];
refIndex ← refIndex + 1}
ELSE BumpCount[sei]};
RecordLhs: PUBLIC PROC[sei: ISEIndex] = {
key: RefItem;
IF dataPtr.switches['u] AND (DecodeCard[seb[sei].idInfo] = 0 AND ~seb[sei].mark4) THEN {
key ← [kind:rhs, sei:sei];
FOR i: CARDINAL DECREASING IN [0..refIndex) DO
SELECT refStack[i] FROM
key => {refStack[i].kind ← lhs; EXIT};
RefSeal => EXIT;
ENDCASE;
ENDLOOP
}
};
SealRefStack: PUBLIC PROC = {
IF refIndex >= refStack.length THEN AdjustRefStack[refStack.length + 8];
refStack[refIndex] ← RefSeal; refIndex ← refIndex + 1};
UnsealRefStack: PUBLIC PROC = {
ClearRefStack[]; refIndex ← refIndex - 1;
IF refStack[refIndex] # RefSeal THEN ERROR};
ClearRefStack: PUBLIC PROC = {
sei: ISEIndex;
FOR i: CARDINAL DECREASING IN [0..refIndex) UNTIL refStack[i] = RefSeal DO
sei ← refStack[i].sei;
IF refStack[i].kind = rhs
AND ~ConstantInit[sei]
AND (~dataPtr.interface OR CtxLevel[seb[sei].idCtx] # lG) THEN
Log.WarningSei[uninitialized, sei];
BumpCount[sei];
refIndex ← refIndex - 1;
ENDLOOP;
IF refStack.length > 16 AND refIndex <= 16 THEN AdjustRefStack[16]};
ConstantInit: PROC[sei: ISEIndex] RETURNS[BOOL] = {
node: Tree.Index;
IF seb[sei].constant THEN RETURN[TRUE];
node ← DecodeTreeIndex[seb[sei].idValue];
RETURN[seb[sei].immutable
AND node # Tree.nullIndex AND OpName[tb[node].son[3]] = body]
};
tables defining the current symbol table
tb: Tree.Base;-- tree base
seb: Symbols.Base;-- se table
ctxb: Symbols.Base;-- context table
mdb: Symbols.Base;-- module directory base
IdNotify: Alloc.Notifier = {
called whenever the main symbol table is repacked
tb ← base[Tree.treeType];
seb ← base[seType]; ctxb ← base[ctxType]; mdb ← base[mdType]};
type table management
EnterType: PUBLIC PROC[type: Type, canonical: BOOL←TRUE] = {
SymLiteralOps.EnterType[type, canonical];
CompleteRCType[TypeRoot[type]]};
CompleteContext: PROC[ctx: CTXIndex] = {
WITH c: ctxb[ctx] SELECT FROM
simple =>
IF c.copied < $rc THEN {
c.copied ← $rc;
FOR sei: ISEIndex ← FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull DO
type: Type = seb[sei].idType;
CompleteRCType[IF type = typeTYPE THEN sei ELSE TypeRoot[type]];
ENDLOOP;
};
included =>
IF CtxLevel[ctx] = lZ THEN Copier.CompleteContext[LOOPHOLE[ctx], $rc];
ENDCASE
};
CompleteRCType: PROC[type: Type] = {
IF RCType[type] # none THEN {
subType: CSEIndex = UnderType[type];
WITH t: seb[subType] SELECT FROM
record => CompleteContext[t.fieldCtx];
array => CompleteRCType[TypeRoot[t.componentType]];
union => CompleteContext[t.caseCtx];
sequence => CompleteRCType[TypeRoot[t.componentType]];
ENDCASE => NULL
}
};
EnterStructure: PROC[type: Type] = {EnterType[UnderType[type], TRUE]};
EnterComposite: PUBLIC PROC[type: Type, t: Tree.Link, init: BOOL] = {
SELECT OpName[t] FROM
loophole, cast, safen, pad => {
t1: Tree.Link = NthSon[t, 1];
EnterComposite[OperandType[t1], t1, init];
IF RCType[type] = composite THEN EnterStructure[type]};
construct =>
IF RCType[type] = composite THEN {
node: Tree.Index = GetNode[t];
EnterFieldTypes[
RecordRoot[LOOPHOLE[UnderType[ToType[tb[node].info]]]], tb[node].son[2], init];
IF ~init THEN EnterStructure[type]-- in case constant-folded
};
union => {
node: Tree.Index = GetNode[t];
EnterFieldTypes[LOOPHOLE[UnderType[GetSe[tb[node].son[1]]]], tb[node].son[2], init]};
rowcons => {
node: Tree.Index = GetNode[t];
aSei: ArraySEIndex = LOOPHOLE[UnderType[ToType[tb[node].info]]];
cSei: CSEIndex = UnderType[seb[aSei].componentType];
EnterElement: Tree.Scan = {EnterComposite[cSei, t, init]};
IF RCType[cSei] # none THEN {
ScanList[tb[node].son[2], EnterElement];
IF ~init THEN EnterStructure[type]}
};
all => {
node: Tree.Index = GetNode[t];
aSei: ArraySEIndex = LOOPHOLE[UnderType[ToType[tb[node].info]]];
cSei: CSEIndex = UnderType[seb[aSei].componentType];
IF RCType[cSei] # none THEN {
EnterComposite[cSei, NthSon[t, 1], FALSE];
IF ~init THEN EnterStructure[type]}
};
ENDCASE =>
SELECT TypeForm[type] FROM
$union => Log.ErrorTree[unimplemented, t];
$sequence => IF t # Tree.Null THEN Log.ErrorTree[unimplemented, t];
ENDCASE => IF RCType[type] = composite THEN EnterStructure[type]
};
EnterFieldTypes: PROC[rSei: RecordSEIndex, t: Tree.Link, init: BOOL] = {
sei: ISEIndex ← FirstCtxSe[seb[rSei].fieldCtx];
EnterField: Tree.Scan = {
IF sei # ISENull THEN {
subType: CSEIndex = UnderType[seb[sei].idType];
WITH s: seb[subType] SELECT FROM
record => {
IF s.hints.variant AND RCType[subType] = composite THEN
EnterType[subType, TRUE];
EnterComposite[subType, t, init]};
ENDCASE => EnterComposite[subType, t, init]};
sei ← NextSe[sei]};
ScanList[t, EnterField]};
EnterMarkedType: PROC[type: Type] = INLINE {
EnterType[MarkedType[UnderType[type]]]};
EnterDiscriminator: PROC[t: Tree.Link] = INLINE {-- guarantee that union is copied
[] ← VariantUnionType[OpenedType[OperandType[t]]]};
EnterTags: PROC[type: Type] = INLINE {
subType: CSEIndex ← OpenedType[type];
DO
next: CSEIndex ← UnderType[TypeLink[subType]];
IF next = CSENull THEN EXIT;
[] ← VariantUnionType[next];-- guarantee that union is copied
subType ← next;
ENDLOOP
};
identifier look-up
Id: PUBLIC PROC[hti: HTIndex] RETURNS[val: Tree.Link] = {
sei: ISEIndex;
type: Type;
ctx: CTXIndex;
baseV: Tree.Link;
attr: Attr ← voidAttr;
indirect: BOOL;
[sei, baseV, indirect] ← FindSe[hti];
IF sei # ISENull THEN {
IF baseV = Tree.Null THEN RecordMention[sei] ELSE BumpCount[sei];
IF ~seb[sei].mark3 THEN ResolveIdType[sei];
val ← [symbol[index: sei]]; type ← seb[sei].idType;
ctx ← seb[sei].idCtx;
SELECT ctxb[ctx].ctxType FROM
included => {
attr.const ← ConstantId[sei];
IF baseV = Tree.Null AND (~attr.const OR ~InterfaceConst[sei]) THEN
Log.ErrorSei[notImported, sei]};
imported => {
IF ~dataPtr.interface AND TypeForm[type] = $ref THEN
[val, type] ← DeRef[val, type];
attr.const ← FALSE};
ENDCASE => {
IF ~ConstResolved[sei] THEN ResolveIdValue[sei];
attr.const ← seb[sei].constant};
SELECT TRUE FROM
baseV = Tree.Null => {
IF ctx = P3S.currentBody.argCtx THEN phraseNP ← ref;
IF CtxLevel[ctx] = lZ AND ~attr.const THEN
SELECT ctx FROM
IN [FirstStandardCtx .. LastStandardCtx], dataPtr.moduleCtx => NULL;
ENDCASE => Log.ErrorSei[missingBase, sei]
};
(~attr.const AND ctxb[ctx].ctxType # imported) => {
attr ← And[UpdateTreeAttr[baseV], attr];
PushTree[CopyTree[baseV]]; PushTree[val];
IF indirect THEN {
PushNode[dot, 2]; SetAttr[2, TypeForm[OperandType[baseV]] = $long]}
ELSE {PushNode[dollar, 2]; SetAttr[2, LongPath[baseV]]};
SetType[type]; val ← PopTree[]};
ENDCASE;
IF VarType[type] THEN [val, type] ← DeRef[val, type, TRUE];
IF seb[sei].extended THEN attr ← And[UpdateExtension[sei], attr]}
ELSE {
attr ← And[UpdateTreeAttr[baseV], attr]; type ← OperandType[baseV];
IF indirect THEN [val, type] ← DeRef[CopyTree[baseV], type]
ELSE val ← CopyTree[baseV]};
RPush[type, attr];
RETURN};
DeRef: PROC[t: Tree.Link, type: Type, var: BOOL←FALSE] RETURNS [Tree.Link, Type] = {
rType: Type = ReferentType[type];
PushTree[t];
PushNode[uparrow, 1];
SetType[rType]; SetAttr[2, TypeForm[type] = $long]; SetAttr[3, var];
RETURN[PopTree[], rType]};
UpdateExtension: PROC[sei: ISEIndex] RETURNS[attr: Attr] = {
t: Tree.Link;
tag: ExtensionType;
[tag, t] ← FindExtension[sei];
IF tag # value THEN attr ← fullAttr
ELSE {attr ← UpdateTreeAttr[t]; attr.const ← TRUE};
RETURN};
FieldId: PUBLIC PROC[hti: HTIndex, type: RecordSEIndex] RETURNS[n: NAT, sei: ISEIndex] = {
[n, sei] ← SearchRecord[hti, type];
IF n # 0 THEN {
IF ~seb[sei].mark3 THEN ResolveIdType[sei];
IF ~ConstResolved[sei] THEN ResolveIdValue[sei];
BumpCount[sei]};
RETURN};
InterfaceId: PUBLIC PROC[hti: HTIndex, ctx: CTXIndex]
RETURNS[found: BOOL, sei: ISEIndex] = {
[found, sei] ← SearchCtxList[hti, ctx];
IF found THEN {
SELECT ctxb[seb[sei].idCtx].ctxType FROM
imported => NULL;
included =>
IF ~ConstantId[sei] OR ~InterfaceConst[sei] THEN Log.ErrorSei[notImported, sei];
ENDCASE => {
IF ~seb[sei].mark3 THEN ResolveIdType[sei];
IF ~ConstResolved[sei] THEN ResolveIdValue[sei]};
BumpCount[sei]};
RETURN};
ClusterId: PUBLIC PROC[hti: HTIndex, ctx: CTXIndex]
RETURNS[found: BOOL, sei: ISEIndex] = {
WITH c: ctxb[ctx] SELECT FROM
simple => [found, sei] ← SearchCtxList[hti, ctx];
included => {
mdi: MDIndex = c.module;
IF mdb[mdi].defaultImport = CTXNull THEN { -- avoid creating spurious principal imports
IF SearchCtxList[hti, ctx].found THEN
[found, sei] ← SearchCtxList[hti, DefaultImport[LOOPHOLE[ctx], FALSE]]
ELSE {found ← FALSE; sei ← ISENull}}
ELSE [found, sei] ← SearchCtxList[hti, mdb[mdi].defaultImport]};
ENDCASE => {found ← FALSE; sei ← ISENull};
IF found THEN {
IF ~seb[sei].mark3 THEN ResolveIdType[sei];
BumpCount[sei]};
RETURN};
service routines for above
InterfaceConst: PROC[sei: ISEIndex] RETURNS[BOOL] = INLINE {
RETURN[SELECT LinkMode[sei] FROM val, ref => FALSE, ENDCASE => TRUE]};
ConstResolved: PROC[sei: ISEIndex] RETURNS[BOOL] = {
RETURN[(seb[sei].mark4 OR seb[sei].idValue = EncodeTreeIndex[Tree.nullIndex])
OR ~seb[sei].immutable OR (seb[sei].constant AND ~RootType[sei])]};
RootType: PROC[sei: ISEIndex] RETURNS[BOOL] = INLINE {
RETURN[seb[sei].idType = typeTYPE AND TypeLink[sei] = nullType]};
ResolveIdType: PROC[sei: ISEIndex] = {
declNode: Tree.Index ← DecodeTreeIndex[seb[sei].idValue];
IF tb[declNode].attr3 # P3.mark THEN ResolveType[sei]};
ResolveIdValue: PROC[sei: ISEIndex] = {
declNode: Tree.Index ← DecodeTreeIndex[seb[sei].idValue];
IF seb[sei].mark3 AND tb[declNode].attr2 # P3.mark THEN ResolveValue[sei]};
BumpCount: PUBLIC PROC[sei: ISEIndex] = {
OPEN seb[sei];
IF idType # typeTYPE AND (~mark4 OR (ctxb[idCtx].ctxType = imported AND ~constant)) THEN
idInfo ← EncodeCard[DecodeCard[idInfo] + 1]
};
keyed-list matching
CompleteRecord: PUBLIC PROC[rSei: RecordSEIndex, depth: Closure←$unit] = {
ctx: CTXIndex = seb[rSei].fieldCtx;
WITH ctxb[ctx] SELECT FROM
simple => NULL;
included => IF CtxLevel[ctx] = lZ THEN Copier.CompleteContext[LOOPHOLE[ctx], depth];
ENDCASE
};
ArrangeKeys: PUBLIC PROC[
expList: Tree.Link,
nextKey: PROC RETURNS[HTIndex],
omittedValue: PROC RETURNS[Tree.Link]]
RETURNS[nItems: CARDINAL] = {
Pair: TYPE = RECORD[key: HTIndex, val: Tree.Link];
PairList: TYPE = RECORD[SEQUENCE length: CARDINAL OF Pair];
a: REF PairList;
n: CARDINAL;
duplicate: BOOL;
ListItem: Tree.Map = {
node: Tree.Index = GetNode[t];
hti: HTIndex = GetHash[tb[node].son[1]];
FOR i: CARDINAL IN [0 .. n) DO
IF hti = a[i].key THEN GO TO Duplicate;
REPEAT
Duplicate => {duplicate ← TRUE; v ← t};
FINISHED => {
a[n] ← [key:hti, val:tb[node].son[2]]; n ← n+1;
tb[node].son[2] ← Tree.Null; v ← FreeTree[t]};
ENDLOOP;
RETURN};
DuplicateItem: Tree.Scan = {
IF t # Tree.Null THEN {
node: Tree.Index = GetNode[t];
Log.ErrorTree[duplicateKey, tb[node].son[1]];
tb[node].son[2] ← P3.VoidExp[tb[node].son[2]]}
};
key: HTIndex;
m: CARDINAL;
n ← ListLength[expList]; nItems ← 0;
a ← NEW[PairList[n]];
n ← 0; duplicate ← FALSE; expList ← UpdateList[expList, ListItem]; m ← n;
UNTIL (key ← nextKey[]) = HTNull DO
FOR i: CARDINAL IN [0 .. n) DO
IF key = a[i].key THEN GO TO Found;
REPEAT
Found => {PushTree[a[i].val]; a[i].key ← HTNull; m ← m-1};
FINISHED => PushTree[omittedValue[]];
ENDLOOP;
nItems ← nItems + 1;
ENDLOOP;
IF duplicate THEN ScanList[expList, DuplicateItem];
IF m # 0 THEN
FOR i: CARDINAL IN [0 .. n) DO
IF a[i].key # HTNull THEN {
Log.ErrorHti[unknownKey, a[i].key]; [] ← FreeTree[P3.VoidExp[a[i].val]]};
ENDLOOP;
[] ← FreeTree[expList]; a ← NIL;
RETURN};
service routines for copying/mapping list structure
BindTree: PUBLIC PROC[t: Tree.Link, binding: PROC[ISEIndex] RETURNS[Tree.Link]]
RETURNS [Tree.Link] = {
MapTree: Tree.Map = {
IF t = Tree.Null THEN v ← Tree.Null
ELSE WITH t SELECT GetTag[t] FROM
symbol => v ← binding[index];
subtree => {
node: Tree.Index = index;
v ← SELECT TRUE FROM
tb[node].shared =>
SELECT tb[node].name FROM
call, callx => MapThreadedTree[t],
ENDCASE => t,
ENDCASE => TreeOps.CopyTree[[baseP:@tb, link:t], MapTree]};
ENDCASE => v ← t;
RETURN};
MapThread: Tree.Map = {
IF OpName[t] = thread THEN {
node: Tree.Index = GetNode[t];
PushTree[MapTree[tb[node].son[1]]]; PushTree[Tree.Null];
PushNode[thread, 2]; SetAttr[1, FALSE]; SetInfo[FromBti[P3S.currentScope]];
v ← PopTree[]}
ELSE v ← MapTree[t]};
MapThreadedTree: Tree.Map = {
sThread: Tree.Index = GetNode[NthSon[t, 1]];
dThread: Tree.Index;
v ← TreeOps.CopyTree[[baseP:@tb, link:t], MapThread];
dThread ← GetNode[NthSon[v, 1]];
tb[dThread].son[2] ← tb[sThread].son[2];
tb[sThread].son[2] ← v; MarkShared[v, TRUE];
RETURN};
RETURN[MapTree[t]]};
IdentityBinding: PROC[sei: ISEIndex] RETURNS[Tree.Link] = {
RETURN[[symbol[index: sei]]]};
CopyTree: PUBLIC Tree.Map = {RETURN[BindTree[t, IdentityBinding]]};
attribute completion/updating
EnterRefLits: PROC[node: Tree.Index] = {
IF node # Tree.nullIndex THEN
SELECT tb[node].name FROM
assign, assignx =>
IF tb[node].attr2 AND tb[node].attr3 THEN
EnterComposite[OperandType[tb[node].son[1]], tb[node].son[2], tb[node].attr1];
new =>
IF tb[node].attr3 THEN {
subType: Type = TypeForTree[tb[node].son[2]];
EnterType[TypeRoot[subType], FALSE];
IF tb[node].son[3] # Tree.Null THEN
EnterComposite[UnderType[subType], tb[node].son[3], TRUE]};
listcons =>
IF tb[node].attr3 THEN {
rSei: Type = ReferentType[ToType[tb[node].info]];
cSei: CSEIndex = UnderType[ItemType[rSei]];
EnterElement: Tree.Scan = {EnterComposite[cSei, t, TRUE]};
EnterType[TypeRoot[rSei], FALSE];
ScanList[tb[node].son[2], EnterElement]};
ditem => {
sei: ISEIndex = FirstId[GetNode[tb[node].son[1]]];
UpdateNarrowing[seb[sei].idType, tb[node].attr2, tb[node].attr3]};
narrow => {
IF RCType[ToType[tb[node].info]] = simple THEN {
nType: CSEIndex = NormalType[ToType[tb[node].info]];
WITH t: seb[nType] SELECT FROM
ref => EnterType[t.refType, FALSE];
ENDCASE => NULL};
UpdateNarrowing[ToType[tb[node].info], tb[node].attr2, tb[node].attr3]};
istype =>
UpdateNarrowing[TypeForTree[tb[node].son[2]], tb[node].attr2, tb[node].attr3];
atom => {
SymLiteralOps.EnterAtom[GetHash[tb[node].son[1]]];
EnterType[dataPtr.typeAtomRecord, FALSE]};
bind, bindx =>
IF ~tb[node].attr3 THEN EnterDiscriminator[NthSon[tb[node].son[1], 2]];
ENDCASE};
UpdateNarrowing: PROC[type: Type, rtTest, tagTest: BOOL] = {
IF rtTest THEN EnterMarkedType[type];
IF tagTest THEN EnterTags[type]};
UpdateTreeAttr: PUBLIC PROC[t: Tree.Link] RETURNS[attr: Attr] = {
traverses the tree, incrementing reference counts for ids
UpdateAttr: Tree.Scan = {
WITH t SELECT GetTag[t] FROM
symbol => {
IF seb[index].idCtx = P3S.currentBody.argCtx THEN
phraseNP ← MergeNP[phraseNP][ref];
BumpCount[index]};
subtree => {
node: Tree.Index = index;
ScanSons[t, UpdateAttr];
EnterRefLits[node];
SELECT tb[node].name FROM
assign, assignx => {
attr.noAssign ← FALSE; phraseNP ← MergeNP[phraseNP][set]};
IN [call..join], IN [callx..joinx] => {-- conservative
P3S.currentBody.noXfers ← attr.noXfer ← FALSE;
attr.noAssign ← FALSE; phraseNP ← MergeNP[phraseNP][set]};
new, listcons => P3S.currentBody.noXfers ← attr.noXfer ← FALSE;
ENDCASE => NULL};
ENDCASE => NULL};
attr ← fullAttr; phraseNP ← none; UpdateAttr[t];
attr.const ← FALSE; RETURN};
context stack management
ContextEntry: TYPE = RECORD[
base: Tree.Link,-- the basing expr (empty if none)
indirect: BOOL,-- true iff basing expr is pointer
info: SELECT tag: * FROM
list => [ctx: CTXIndex],-- a single context
record => [rSei: RecordSEIndex],-- a group of contexts
hash => [ctxHti: HTIndex],-- a single identifier
ENDCASE
];
ContextSequence: TYPE = RECORD[SEQUENCE length: NAT OF ContextEntry];
ContextStack: TYPE = REF ContextSequence;
ctxStack: ContextStack;
ctxIndex: INTEGER;
ContextIncr: CARDINAL = 16;
ExpandStack: PROC = {
oldstack: ContextStack ← ctxStack;
ctxStack ← NEW[ContextSequence[oldstack.length + ContextIncr]];
FOR i: CARDINAL IN [0 .. oldstack.length) DO ctxStack[i] ← oldstack[i] ENDLOOP;
oldstack ← NIL};
PushCtx: PUBLIC PROC[ctx: CTXIndex] = {
IF (ctxIndex ← ctxIndex+1) >= ctxStack.length THEN ExpandStack[];
ctxStack[ctxIndex] ← [base:Tree.Null, indirect:FALSE, info:list[ctx]]};
PushRecordCtx: PUBLIC PROC[rSei: RecordSEIndex, base: Tree.Link, indirect: BOOL] = {
IF (ctxIndex ← ctxIndex+1) >= ctxStack.length THEN ExpandStack[];
ctxStack[ctxIndex] ← [base:base, indirect:indirect, info:record[rSei]]};
UpdateRecordCtx: PUBLIC PROC[type: RecordSEIndex] = {
WITH ctxStack[ctxIndex] SELECT FROM
record => rSei ← type;
ENDCASE => ERROR
};
PushHtCtx: PUBLIC PROC[hti: HTIndex, base: Tree.Link, indirect: BOOL] = {
IF (ctxIndex ← ctxIndex+1) >= ctxStack.length THEN ExpandStack[];
ctxStack[ctxIndex] ← [base:base, indirect:indirect, info:hash[hti]]};
PopCtx: PUBLIC PROC = {ctxIndex ← ctxIndex-1};
TopCtx: PUBLIC PROC RETURNS[CTXIndex] = {
RETURN[WITH ctxStack[ctxIndex] SELECT FROM list => ctx, ENDCASE => ERROR]};
primary lookup
FindSe: PUBLIC PROC[hti: HTIndex] RETURNS[ISEIndex, Tree.Link, BOOL] = {
found: BOOL;
nHits: NAT;
sei: ISEIndex;
FOR i: INTEGER DECREASING IN [0 .. ctxIndex] DO
WITH s: ctxStack[i] SELECT FROM
list => {
[found, sei] ← SearchCtxList[hti, s.ctx];
IF found THEN GO TO Found};
record => {
[nHits, sei] ← SearchRecord[hti, s.rSei];
SELECT nHits FROM
= 1 => GO TO Found;
> 1 => GO TO Ambiguous;
ENDCASE};
hash => IF hti = s.ctxHti THEN {sei ← ISENull; GO TO Found};
ENDCASE;
REPEAT
Found => RETURN[sei, ctxStack[i].base, ctxStack[i].indirect];
Ambiguous => {
Log.ErrorHti[ambiguousId, hti];
RETURN[dataPtr.seAnon, Tree.Null, FALSE]};
FINISHED => {
IF hti # HTNull THEN Log.ErrorHti[unknownId, hti];
RETURN[dataPtr.seAnon, Tree.Null, FALSE]};
ENDLOOP
};
SearchCtxList: PUBLIC PROC[hti: HTIndex, ctx: CTXIndex]
RETURNS [found: BOOL, sei: ISEIndex] = {
IF ctx = CTXNull THEN RETURN[FALSE, ISENull];
WITH c: ctxb[ctx] SELECT FROM
included => {
IF c.restricted THEN {
sei ← SearchRestrictedCtx[hti, LOOPHOLE[ctx]]; found ← (sei # ISENull)}
ELSE {
sei ← SearchContext[hti, ctx];
SELECT TRUE FROM
(sei # ISENull) => found ← TRUE;
(~c.closed AND ~c.reset) => [found, sei] ← Copier.SearchFileCtx[hti, LOOPHOLE[ctx]];
ENDCASE => found ← FALSE};
IF found AND ~seb[sei].public AND ~Shared[ctx]
AND sei # dataPtr.seAnon THEN Log.ErrorSei[privateId, sei]};
imported => {
iCtx: IncludedCTXIndex = c.includeLink;
sei ← SearchContext[hti, ctx];
IF sei # ISENull THEN
found ← ~ctxb[iCtx].restricted OR CheckRestrictedCtx[hti, iCtx] # ISENull
ELSE {
[found, sei] ← SearchCtxList[hti, iCtx];
IF found AND sei # dataPtr.seAnon THEN
SELECT LinkMode[sei] FROM
val => {MoveSe[sei, ctx]; ImportSe[sei, ctx]};
ref => {
MoveSe[sei, ctx];
IF ~dataPtr.interface AND ~VarType[UnderType[seb[sei].idType]] THEN {
seb[sei].idType ← MakeRefType[
cType: seb[sei].idType, readOnly: seb[sei].immutable,
hint: typeANY];
seb[sei].immutable ← TRUE};
ImportSe[sei, ctx]};
ENDCASE}};
ENDCASE => {sei ← SearchContext[hti, ctx]; found ← (sei # ISENull)};
RETURN};
MoveSe: PROC[sei: ISEIndex, ctx: CTXIndex] = {
Copier.Delink[sei]; seb[sei].idCtx ← ctx;
SetSeLink[sei, ctxb[ctx].seList]; ctxb[ctx].seList ← sei};
import handling
MainIncludedCtx: PUBLIC PROC[mdi: MDIndex] RETURNS[ctx: IncludedCTXIndex] = {
FOR ctx ← mdb[mdi].ctx, ctxb[ctx].chain UNTIL ctx = CTXNull DO
IF CtxLevel[ctx] = lG THEN EXIT ENDLOOP;
RETURN};
DefaultImport: PROC[iCtx: IncludedCTXIndex, new: BOOL] RETURNS[CTXIndex] = {
mdi: MDIndex = ctxb[iCtx].module;
IF mdb[mdi].defaultImport = CTXNull THEN SetDefaultImport[iCtx, new];
RETURN[mdb[mdi].defaultImport]};
ImportTree: PROC[t: Tree.Link, importCtx: CTXIndex] RETURNS[Tree.Link] = {
iCtx: IncludedCTXIndex = WITH c: ctxb[importCtx] SELECT FROM
imported => c.includeLink,
ENDCASE => ERROR;
UpdateBinding: Tree.Map = {
WITH t SELECT GetTag[t] FROM
symbol => {
oldSei: ISEIndex = index;
oldCtx: CTXIndex = seb[oldSei].idCtx;
newSei: ISEIndex;
WITH c: ctxb[oldCtx] SELECT FROM
included =>
IF CtxLevel[oldCtx] # lG OR InterfaceConst[oldSei] THEN newSei ← oldSei
ELSE {
mdi: MDIndex = c.module;
saveRestricted: BOOL = c.restricted;
saveShared: BOOL = mdb[mdi].shared;
targetCtx: CTXIndex;
c.restricted ← FALSE; mdb[mdi].shared ← TRUE;
targetCtx ← IF oldCtx = iCtx
THEN importCtx
ELSE DefaultImport[LOOPHOLE[oldCtx], TRUE];
newSei ← SearchCtxList[seb[oldSei].hash, targetCtx].sei;
mdb[mdi].shared ← saveShared; c.restricted ← saveRestricted};
ENDCASE => newSei ← oldSei;
v ← [symbol[index: newSei]];
IF ~dataPtr.interface AND ctxb[seb[newSei].idCtx].ctxType = imported THEN {
type: CSEIndex = UnderType[seb[newSei].idType];
WITH s: seb[type] SELECT FROM
ref => IF ~s.var THEN [v, ] ← DeRef[v, type];
ENDCASE};
BumpCount[newSei]};
subtree => {
node: Tree.Index = index;
EnterRefLits[node];
v ← UpdateLeaves[t, UpdateBinding]};
ENDCASE => v ← t;
RETURN};
RETURN[UpdateBinding[t]]};
ImportCtx: PROC[ctx, importCtx: CTXIndex, level: NAT] = {
FOR sei: ISEIndex ← FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull DO
ImportSe[sei, importCtx, level] ENDLOOP
};
ImportSe: PROC[sei: ISEIndex, importCtx: CTXIndex, level: NAT𡤀] = {
t: Tree.Link;
tag: ExtensionType;
type: CSEIndex = UnderType[seb[sei].idType];
IF level = 0 THEN -- this trick doesn't generalize (really need a marking scheme)
WITH t: seb[type] SELECT FROM
transfer => {
ImportCtx[ArgCtx[t.typeIn], importCtx, level+1];
ImportCtx[ArgCtx[t.typeOut], importCtx, level+1]};
ENDCASE;
IF seb[sei].extended THEN {
[tag, t] ← FindExtension[sei];
EnterExtension[sei, tag, ImportTree[t, importCtx]]}
};
searching records
SearchRecordSegment: PROC[hti: HTIndex, rSei: RecordSEIndex, suffixed: BOOL]
RETURNS [nHits: NAT, sei: ISEIndex] = {
found: BOOL;
n: NAT;
match: ISEIndex;
[found, sei] ← SearchCtxList[hti, seb[rSei].fieldCtx];
nHits ← IF found THEN 1 ELSE 0;
IF seb[rSei].hints.variant THEN {
tSei: CSEIndex = VariantUnionType[rSei];
WITH t: seb[tSei] SELECT FROM
union => {
IF ~suffixed AND ~t.controlled AND t.overlaid THEN {
[n, match] ← SearchOverlays[hti, t.caseCtx];
IF ~found THEN sei ← match;
nHits ← nHits + n};
IF t.controlled AND seb[t.tagSei].hash = hti THEN {sei ← t.tagSei; nHits ← nHits + 1}};
sequence => {
IF t.controlled AND seb[t.tagSei].hash = hti THEN {sei ← t.tagSei; nHits ← nHits + 1}};
ENDCASE => NULL};
RETURN};
SearchOverlays: PROC[hti: HTIndex, ctx: CTXIndex] RETURNS [nHits: NAT, sei: ISEIndex] = {
WITH ctxb[ctx] SELECT FROM
included => Copier.CompleteContext[LOOPHOLE[ctx]];
ENDCASE;
nHits ← 0; sei ← ISENull;
FOR vSei: ISEIndex ← FirstCtxSe[ctx], NextSe[vSei] UNTIL vSei = ISENull DO
IF seb[vSei].public OR Shared[ctx] THEN {
type: Type = DecodeType[seb[vSei].idInfo];
WITH r: seb[type] SELECT FROM
id => NULL;
cons =>
WITH r SELECT FROM
record => {
n: NAT;
match: ISEIndex;
[n, match] ← SearchRecordSegment[hti, LOOPHOLE[type], FALSE];
IF nHits = 0 THEN sei ← match;
nHits ← nHits + n};
ENDCASE => ERROR;
ENDCASE};
ENDLOOP;
RETURN};
SearchRecord: PROC[hti: HTIndex, type: RecordSEIndex]
RETURNS [nHits: NAT, sei: ISEIndex] = {
rSei: RecordSEIndex ← type;
suffixed: BOOL ← FALSE;
UNTIL rSei = RecordSENull DO
[nHits, sei] ← SearchRecordSegment[hti, rSei, suffixed];
IF nHits # 0 THEN RETURN;
rSei ← WITH seb[rSei] SELECT FROM
linked => LOOPHOLE[UnderType[linkType]],
ENDCASE => RecordSENull;
suffixed ← TRUE;
ENDLOOP;
RETURN[0, ISENull]};
management of restricted contexts
Shared: PUBLIC PROC[ctx: CTXIndex] RETURNS[BOOL] = {
RETURN[WITH c: ctxb[ctx] SELECT FROM
included => mdb[c.module].shared,
imported => Shared[c.includeLink],
ENDCASE => TRUE]
};
CtxRestriction: TYPE = RECORD[ctx: IncludedCTXIndex, list: Tree.Link, linked: BOOL←FALSE];
CtxIdTable: TYPE = RECORD[SEQUENCE length: CARDINAL OF CtxRestriction];
ctxIdTable: REF CtxIdTable;
CtxHash: PROC[ctx: IncludedCTXIndex] RETURNS[CARDINAL] = INLINE {
RETURN[CARDINAL[(ctx-IncludedCTXNull)/CTXRecord.included.SIZE] MOD ctxIdTable.length]
};
MakeIdTable: PUBLIC PROC[nIdLists: CARDINAL] = {
ctxIdTable ← NEW[CtxIdTable[nIdLists]];
FOR i: CARDINAL IN [0..nIdLists) DO ctxIdTable[i] ← [IncludedCTXNull, Tree.Null] ENDLOOP};
EnterIdList: PUBLIC PROC[ctx: IncludedCTXIndex, list: Tree.Link] = {
i: CARDINAL ← CtxHash[ctx];
DO
SELECT ctxIdTable[i].ctx FROM
IncludedCTXNull => {ctxIdTable[i] ← [ctx, list]; EXIT};
ctx => ctxIdTable[i].linked ← TRUE;
ENDCASE;
IF (i ← i+1) = ctxIdTable.length THEN i ← 0;
ENDLOOP
};
CheckRestrictedCtx: PROC[hti: HTIndex, ctx: IncludedCTXIndex]
RETURNS [sei: ISEIndex] = {
TestId: Tree.Test = {
WITH t SELECT GetTag[t] FROM
hash => IF index = hti THEN sei ← dataPtr.seAnon;
symbol => IF seb[index].hash = hti THEN sei ← index;
ENDCASE;
RETURN[sei # ISENull]};
i: CARDINAL ← CtxHash[ctx];
DO
IF ctxIdTable[i].ctx = ctx THEN {
sei ← ISENull; SearchList[ctxIdTable[i].list, TestId];
IF sei # ISENull OR ~ctxIdTable[i].linked THEN EXIT};
IF (i ← i+1) = ctxIdTable.length THEN i ← 0;
ENDLOOP;
IF sei # ISENull AND seb[sei].idCtx = CTXNull THEN seb[sei].idCtx ← ctx;
RETURN};
SearchRestrictedCtx: PROC[hti: HTIndex, ctx: IncludedCTXIndex]
RETURNS [sei: ISEIndex] = {
sei ← CheckRestrictedCtx[hti, ctx];
IF sei # ISENull AND sei # dataPtr.seAnon AND seb[sei].idCtx # ctx THEN {
[ , sei] ← Copier.SearchFileCtx[hti, ctx];
seb[sei].public ← TRUE};-- second copy, access already checked
RETURN};
CheckDirectoryIds: Tree.Scan = {
CheckId: Tree.Scan = {
WITH t SELECT GetTag[t] FROM
symbol => IF seb[index].idCtx = CTXNull THEN Log.WarningSei[unusedId, index];
ENDCASE};
node: Tree.Index = GetNode[t];
saveIndex: SourceMap.Loc = dataPtr.textIndex;
dataPtr.textIndex ← ToLoc[tb[node].info];
ScanList[tb[node].son[3], CheckId];
dataPtr.textIndex ← saveIndex};
CheckDisjoint: PUBLIC PROC[ctx1, ctx2: CTXIndex] = {
hti: HTIndex;
saveIndex: SourceMap.Loc = dataPtr.textIndex;
IF ctx1 # CTXNull AND ctx2 # CTXNull THEN
FOR sei: ISEIndex ← FirstCtxSe[ctx2], NextSe[sei] UNTIL sei = ISENull DO
hti ← seb[sei].hash;
IF hti # HTNull AND SearchContext[hti, ctx1] # ISENull THEN {
IF ~seb[sei].mark3 THEN
dataPtr.textIndex ← ToLoc[tb[DecodeTreeIndex[seb[sei].idValue]].info];
Log.ErrorHti[duplicateId, hti]};
ENDLOOP;
dataPtr.textIndex ← saveIndex};
basing management
OpenedType: PROC[type: Type] RETURNS[CSEIndex] = {
subType: CSEIndex = NormalType[type];
RETURN[UnderType[WITH t: seb[subType] SELECT FROM
ref => t.refType,
ENDCASE => type]]
};
OpenPointer: PUBLIC PROC[t: Tree.Link, type: Type] RETURNS [Tree.Link, CSEIndex] = {
nType, rType: CSEIndex;
nDerefs: CARDINAL ← 0;
DO
nType ← NormalType[type];
WITH p: seb[nType] SELECT FROM
ref => {
rType ← UnderType[p.refType];
IF P3S.safety = checked AND ~(p.counted OR PermanentType[p.refType]) THEN
Log.ErrorTreeOp[unsafeOp, t, uparrow];
IF seb[NormalType[rType]].typeTag # ref THEN EXIT;
IF (nDerefs ← nDerefs+1) > 63 THEN EXIT};
ENDCASE;
[t, type] ← DeRef[t, type];
ENDLOOP;
RETURN[t, rType]};
BaseTree: PUBLIC PROC[t: Tree.Link, type: Type] RETURNS[val: Tree.Link] = {
PushTree[t]; PushNode[openx, 1]; SetType[type]; SetAttr[1, FALSE];
val ← PopTree[]; MarkShared[val, TRUE]; RETURN};
OpenBase: PUBLIC PROC[t: Tree.Link, hti: HTIndex] RETURNS[v: Tree.Link] = {
type, vType: Type;
nType: CSEIndex;
OpenRecord: PROC[indirect: BOOL] = {
sei: CSEIndex = UnderType[type];
WITH seb[sei] SELECT FROM
record => {
v ← BaseTree[v, vType];
IF hti # HTNull THEN PushHtCtx[hti, v, indirect]
ELSE PushRecordCtx[LOOPHOLE[sei, RecordSEIndex], v, indirect]};
ENDCASE => IF sei # typeANY THEN Log.ErrorTree[typeClash, v]
};
v ← Exp[t, typeANY];
type ← vType ← RType[]; nType ← NormalType[vType]; RPop[];
SELECT TypeForm[nType] FROM
$definition, $transfer => {
ctx: CTXIndex = InterfaceCtx[nType, v];
IF ctx = CTXNull THEN OpenRecord[FALSE]
ELSE IF hti # HTNull THEN PushHtCtx[hti, v, FALSE]
ELSE PushCtx[ctx]};
$ref => {
[v, type] ← OpenPointer[v, vType]; vType ← OperandType[v];
OpenRecord[TRUE]};
ENDCASE => OpenRecord[FALSE];
RETURN};
CloseBase: PUBLIC PROC[t: Tree.Link, hti: HTIndex] = {
type: Type;
CloseRecord: PROC = {IF TypeForm[type] = $record THEN PopCtx[]};
type ← NormalType[OperandType[t]];
SELECT TypeForm[type] FROM
$definition => PopCtx[];
$ref => {type ← ReferentType[type]; CloseRecord[]};
ENDCASE => CloseRecord[]
};
initialization/finalization
IdInit: PUBLIC PROC = {
(dataPtr.table).AddNotify[IdNotify];
refStack ← NEW[RefSequence[16]];
refIndex ← 0;
ctxStack ← NEW[ContextSequence[2*ContextIncr]];
ctxIndex ← -1};
IdReset: PUBLIC Tree.Scan = {
ScanList[t, CheckDirectoryIds];
ctxIdTable ← NIL;
ctxStack ← NIL;
refStack ← NIL;
(dataPtr.table).DropNotify[IdNotify]};
}.