DIRECTORY
A3:
TYPE
USING [
AssignableType, BodyForTree, Bundling, CanonicalType, Default, DefaultInit,
LongPath, OperandInternal, OperandLevel, OperandLhs, OperandType,
PermanentType, TargetType, TypeForTree, Unbundle, VarType, Voidable, VoidItem],
Alloc: TYPE USING [Notifier],
ComData:
TYPE
USING [
interface, mainCtx, ownSymbols, seAnon, textIndex,
typeCONDITION, typeStringBody],
Copier: TYPE USING [SEToken, nullSEToken, CtxNext, TokenHash, TokenValue],
Log: TYPE USING [Error, ErrorHti, ErrorN, ErrorNode, ErrorSei, ErrorTree],
P3:
TYPE
USING [
Attr, emptyAttr, fullAttr, voidAttr, NPUse, MergeNP, SetNP,
And, ArrangeKeys, CatchPhrase, ClusterId, CompleteRecord, CopyTree,
DiscriminatedType, EnterComposite, Exp, FieldId, ForceType,
InterfaceId, MainIncludedCtx, MiscXfer, PopCtx, PushCtx, RAttr, Rhs,
RPop, RPush, RType, Shared, Span, SearchCtxList, SelectVariantType,
SequenceField, UpdateTreeAttr, VariantUnionType, VoidExp, XferForFrame],
P3S:
TYPE
USING [
ImplicitInfo, SelfInfo, currentBody, currentScope, implicit, safety],
Symbols:
TYPE
USING [
Base, HTIndex, SEIndex, ISEIndex, CSEIndex, ArraySEIndex, RecordSEIndex,
ContextLevel, CTXIndex, CBTIndex, TransferMode,
HTNull, ISENull, CSENull, RecordSENull, CTXNull, CBTNull,
lG, typeANY, typeTYPE, bodyType, ctxType, seType],
SymbolOps:
TYPE
USING [
ArgCtx, ConstantId, FindExtension, FirstCtxSe, FirstVisibleSe, NextSe,
NextVisibleSe, NormalType, RCType, ReferentType, TransferTypes,
TypeForm, TypeRoot, UnderType, VisibleCtxEntries, XferMode],
Tree:
TYPE
USING [
Base, Index, Link, Map, NodeName, Scan, Null, treeType],
TreeOps:
TYPE
USING [
FreeNode, FreeTree, GetHash, GetNode, ListHead, ListLength, ListTail, MakeList,
MakeNode, MarkShared, NthSon, OpName, PopTree, PushHash, PushList,
PushNode, PushProperList, PushSe, PushTree, ScanList, SetAttr, SetInfo, UpdateList],
Types: TYPE USING [SymbolTableBase, Assignable];
Pass3Xa:
PROGRAM
IMPORTS
A3, Copier, Log, P3, P3S, SymbolOps, TreeOps, Types,
dataPtr: ComData
EXPORTS P3, P3S = {
OPEN SymbolOps, Symbols, TreeOps, A3, P3;
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)
own: Types.SymbolTableBase;
ExpANotify:
PUBLIC Alloc.Notifier = {
called by allocator whenever table area is repacked
seb ← base[seType]; ctxb ← base[ctxType];
bb ← base[bodyType];
tb ← base[Tree.treeType];
own ← dataPtr.ownSymbols};
parameter reference bookkeeping
expression list manipulation
KeyedList:
PROC [t: Tree.Link]
RETURNS [
BOOL] = {
RETURN [OpName[ListHead[t]] = item]};
PopKeyList:
PROC [nItems:
CARDINAL]
RETURNS [t: Tree.Link] = {
t ← MakeList[nItems];
IF t = Tree.Null AND nItems # 0 THEN {PushTree[t]; PushProperList[1]; t ← PopTree[]};
RETURN};
CheckLength:
PROC [t: Tree.Link, length:
INTEGER] = {
n: INTEGER = ListLength[t];
SELECT n
FROM
= length => NULL;
> length => Log.ErrorN[listLong, n-length];
< length => Log.ErrorN[listShort, length-n];
ENDCASE};
ContextComplete:
PROC [ctx: CTXIndex]
RETURNS [
BOOL] = {
RETURN [
WITH ctxb[ctx]
SELECT
FROM
simple => TRUE,
included => complete,
ENDCASE => FALSE]};
CheckScope:
PUBLIC
PROC [t: Tree.Link, type: CSEIndex]
RETURNS [v: Tree.Link] = {
SELECT XferMode[type]
FROM
proc, signal, error =>
SELECT OperandLevel[t]
FROM
global => v ← t;
local => {Log.ErrorTree[scopeFault, t]; v ← t};
ENDCASE => {
PushTree[t]; PushNode[proccheck, 1]; SetInfo[type];
v ← PopTree[]};
ENDCASE => v ← t;
RETURN};
KeyForHash:
PROC [hti: HTIndex]
RETURNS [HTIndex] = {
RETURN [IF hti = HTNull THEN seb[dataPtr.seAnon].hash ELSE hti]};
HashForSe:
PROC [sei: ISEIndex]
RETURNS [HTIndex] = {
RETURN [IF sei = ISENull THEN HTNull ELSE KeyForHash[seb[sei].hash]]};
PadList:
PROC [record: RecordSEIndex, expList: Tree.Link]
RETURNS [Tree.Link] = {
ctx: CTXIndex = seb[record].fieldCtx;
sei: ISEIndex ← FirstVisibleSe[ctx];
added: BOOL ← FALSE;
nFields: CARDINAL ← 0;
PushField: Tree.Map = {
PushTree[t]; nFields ← nFields + 1; sei ← NextSe[sei];
RETURN [Tree.Null]};
[] ← FreeTree[UpdateList[expList, PushField]];
UNTIL sei = ISENull
DO
IF ~seb[sei].extended
AND (seb[record].argument
OR Default[seb[sei].idType] = none)
THEN
EXIT;
PushTree[Tree.Null]; added ← TRUE; nFields ← nFields + 1;
sei ← NextSe[sei];
ENDLOOP;
IF added THEN PushProperList[nFields] ELSE PushList[nFields];
RETURN [PopTree[]]};
FieldDefault:
PUBLIC
PROC [sei: ISEIndex]
RETURNS [v: Tree.Link] = {
CheckOption: Tree.Scan = {IF OpName[t] # void THEN v ← CopyTree[t]};
v ← Tree.Null; ScanList[FindExtension[sei].tree, CheckOption];
RPush[UnderType[seb[sei].idType],
IF v=Tree.Null THEN voidAttr ELSE UpdateTreeAttr[v]];
RETURN};
FieldVoid:
PROC [t: Tree.Link]
RETURNS [Tree.Link] = {
[] ← FreeTree[t]; phraseNP ← none; RPush[typeANY, voidAttr];
RETURN [Tree.Null]};
MatchFields:
PUBLIC
PROC [
record: RecordSEIndex, expList: Tree.Link,
init: BOOL ← FALSE, scopeCheck: BOOL ← TRUE]
RETURNS [val: Tree.Link] = {
nFields: CARDINAL;
ctx: CTXIndex;
sei: ISEIndex;
attr: Attr ← fullAttr;
exitNP: NPUse ← none;
EvaluateField: Tree.Map = {
subAttr: Attr;
type: CSEIndex;
IF sei # ISENull
AND ~(seb[sei].public
OR init
OR Shared[ctx])
THEN
Log.ErrorSei[noAccess, sei];
SELECT
TRUE
FROM
(t = Tree.Null) =>
v ←
SELECT
TRUE
FROM
(sei = ISENull) => FieldVoid[t],
(seb[sei].extended) => FieldDefault[sei],
(seb[record].argument) => FieldVoid[t],
ENDCASE => DefaultInit[seb[sei].idType];
(OpName[t] = void) => v ← FieldVoid[t];
ENDCASE => {
target: CSEIndex =
TargetType[IF sei=ISENull THEN typeANY ELSE UnderType[seb[sei].idType]];
v ← IF init THEN Initialization[target, t] ELSE Rhs[t, target]};
subAttr ← RAttr[]; type ← RType[]; RPop[];
IF v = Tree.Null
AND
~(
IF seb[sei].extended
THEN VoidItem[FindExtension[sei].tree]
ELSE Voidable[seb[sei].idType]) THEN Log.ErrorSei[elision, sei];
IF scopeCheck
AND P3S.safety = checked
THEN
IF TypeForm[type] = transfer THEN v ← CheckScope[v, type];
attr ← And[attr, subAttr]; exitNP ← MergeNP[exitNP][phraseNP];
sei ← NextSe[sei];
RETURN};
IF record = CSENull THEN {CheckLength[expList, 0]; sei ← ISENull}
ELSE {
CompleteRecord[record];
IF ~ContextComplete[seb[record].fieldCtx]
THEN {
IF seb[record].hints.privateFields THEN Log.Error[noAccess];
sei ← ISENull}
ELSE {
ctx ← seb[record].fieldCtx;
IF KeyedList[expList]
THEN {
sei: ISEIndex;
started: BOOL ← FALSE;
NextKey:
PROC
RETURNS [HTIndex] = {
SELECT
TRUE
FROM
~started => {sei ← FirstVisibleSe[ctx]; started ← TRUE};
(sei # ISENull) => sei ← NextVisibleSe[sei];
ENDCASE;
RETURN [HashForSe[sei]]};
OmittedValue:
PROC
RETURNS [t: Tree.Link] = {
IF ~seb[sei].extended
AND (seb[record].argument
OR Default[seb[sei].idType] = none)
THEN {
Log.ErrorHti[omittedKey, seb[sei].hash];
t ← [symbol[dataPtr.seAnon]]}
ELSE t ← Tree.Null;
RETURN};
nFields ← ArrangeKeys[expList, NextKey, OmittedValue];
expList ← PopKeyList[nFields]}
ELSE {
nFields ← VisibleCtxEntries[ctx];
IF ListLength[expList] < nFields THEN expList ← PadList[record, expList];
CheckLength[expList, nFields]};
sei ← FirstVisibleSe[ctx]}};
val ← UpdateList[expList, EvaluateField];
RPush[record, attr]; phraseNP ← exitNP; RETURN};
Dereference:
PROC [t: Tree.Link, type: CSEIndex, long:
BOOL]
RETURNS [Tree.Link] = {
PushTree[t]; PushNode[uparrow, 1]; SetInfo[type]; SetAttr[2, long];
RETURN[PopTree[]]};
ClusterCtx:
PROC [ctx: CTXIndex]
RETURNS [CTXIndex] = {
RETURN [
WITH c: ctxb[ctx]
SELECT
FROM
simple => IF dataPtr.interface THEN dataPtr.mainCtx ELSE CTXNull,
included => MainIncludedCtx[c.module],
ENDCASE => CTXNull]};
ClusterForType:
PROC [type: SEIndex]
RETURNS [CTXIndex] = {
subType: CSEIndex = UnderType[type];
RETURN [
WITH t: seb[subType]
SELECT
FROM
enumerated => ClusterCtx[t.valueCtx],
record => IF ~t.argument THEN ClusterCtx[t.fieldCtx] ELSE CTXNull,
ref => ClusterForType[t.refType],
relative => ClusterForType[t.offsetType],
subrange => ClusterForType[t.rangeType],
long => ClusterForType[t.rangeType],
opaque => seb[t.id].idCtx,
ENDCASE => CTXNull]};
operators
Initialization:
PUBLIC
PROC [type: CSEIndex, t: Tree.Link]
RETURNS [v: Tree.Link] = {
WITH seb[type]
SELECT
FROM
record =>
IF OpName[t] = apply THEN {Construct[GetNode[t], LOOPHOLE[type], TRUE]; v ← t}
ELSE v ← Rhs[t, type];
union =>
IF OpName[t] = apply
THEN {
subType: CSEIndex = UnderType[TypeForTree[NthSon[t, 1]]];
WITH seb[subType]
SELECT
FROM
record => {Construct[GetNode[t], LOOPHOLE[subType], TRUE]; v ← t};
ENDCASE => v ← Rhs[t, type]}
ELSE v ← Rhs[t, type];
array =>
IF OpName[t] = all THEN {All[GetNode[t], type, TRUE]; v ← t}
ELSE v ← Rhs[t, type];
ENDCASE => v ← Rhs[t, type];
RETURN};
Assignment:
PUBLIC
PROC [node: Tree.Index] = {
OPEN tb[node];
lhsType, rhsType: CSEIndex;
attr: Attr;
saveNP: NPUse;
son[1] ← Exp[son[1], typeANY]; saveNP ← phraseNP;
lhsType ← RType[]; attr ← RAttr[]; RPop[];
son[2] ← Rhs[son[2], TargetType[lhsType]];
rhsType ← RType[]; attr ← And[RAttr[], attr]; RPop[];
attr.noAssign ← FALSE; phraseNP ← MergeNP[phraseNP][saveNP];
RPush[rhsType, attr];
IF ~AssignableType[lhsType, P3S.safety=checked]
THEN
Log.ErrorTree[nonLHS, son[1]];
SELECT seb[lhsType].typeTag
FROM
transfer => IF P3S.safety = checked THEN son[2] ← CheckScope[son[2], rhsType];
union =>
IF ~Types.Assignable[
[own, DiscriminatedType[typeANY, son[1]]],
[own, DiscriminatedType[typeANY, son[2]]]] THEN Log.ErrorTree[typeClash, son[2]];
sequence => Log.ErrorTree[typeClash, son[2]];
ENDCASE;
tb[node].attr1 ← FALSE;
SELECT OperandLhs[son[1]]
FROM
counted =>
SELECT RCType[lhsType]
FROM
simple => {tb[node].attr2 ← TRUE; tb[node].attr3 ← FALSE};
composite => {
tb[node].attr2 ← tb[node].attr3 ← TRUE;
EnterComposite[lhsType, son[2], FALSE]};
ENDCASE => tb[node].attr2 ← FALSE;
none => Log.ErrorTree[nonLHS, son[1]];
ENDCASE => tb[node].attr2 ← FALSE};
implicitRecord: PUBLIC RecordSEIndex;
Extract:
PUBLIC
PROC [node: Tree.Index] = {
OPEN tb[node];
type: CSEIndex;
attr: Attr;
ctx: CTXIndex;
sei: ISEIndex;
nL, nR: CARDINAL;
saveImplicit: P3S.ImplicitInfo = P3S.implicit;
saveRecord: RecordSEIndex = implicitRecord;
saveNP: NPUse;
PushItem: Tree.Map = {PushTree[t]; RETURN [Tree.Null]};
Extractor:
PROC [t: Tree.Link]
RETURNS [
BOOL] =
INLINE {
RETURN [OpName[t] = apply AND NthSon[t, 1] = Tree.Null]};
AssignItem: Tree.Map = {
saveType: CSEIndex = P3S.implicit.type;
IF sei # ISENull
AND ~seb[sei].public
AND ~Shared[ctx]
THEN
Log.ErrorSei[noAccess, sei];
IF t = Tree.Null THEN v ← Tree.Null
ELSE {
P3S.implicit.type ← IF sei = ISENull THEN typeANY ELSE UnderType[seb[sei].idType];
IF Extractor[t]
THEN {
subNode: Tree.Index = GetNode[t];
PushTree[tb[subNode].son[2]];
tb[subNode].son[2] ← Tree.Null; FreeNode[subNode];
PushTree[Tree.Null]; v ← MakeNode[extract, 2];
Extract[GetNode[v]]}
ELSE {
PushTree[t]; PushTree[Tree.Null]; v ← MakeNode[assign, 2];
Assignment[GetNode[v]]};
attr ← And[RAttr[], attr]; saveNP ← MergeNP[saveNP][phraseNP]; RPop[]};
sei ← NextSe[sei];
P3S.implicit.type ← saveType; RETURN};
P3S.implicit.tree ← son[2] ← ExtractorRhs[son[2]];
type ← RType[]; P3S.implicit.attr ← attr ← RAttr[]; RPop[];
saveNP ← phraseNP;
IF type = CSENull THEN {nR ← 0; sei ← ISENull}
ELSE {
type ← UnderType[TypeRoot[type]];
WITH seb[type]
SELECT
FROM
record => {
CompleteRecord[LOOPHOLE[type, RecordSEIndex]];
IF ContextComplete[fieldCtx]
THEN {
implicitRecord ← LOOPHOLE[type, RecordSEIndex];
ctx ← fieldCtx; sei ← FirstVisibleSe[ctx];
nR ← VisibleCtxEntries[ctx]}
ELSE {Log.Error[noAccess]; type ← typeANY; nR ← 0; sei ← ISENull}};
ENDCASE => {
Log.ErrorTree[typeClash, son[2]];
type ← typeANY; nR ← 0; sei ← ISENull}};
IF KeyedList[son[1]]
AND nR # 0
THEN {
sei: ISEIndex;
started: BOOL ← FALSE;
NextKey:
PROC
RETURNS [HTIndex] = {
SELECT
TRUE
FROM
~started => {sei ← FirstVisibleSe[ctx]; started ← TRUE};
(sei # ISENull) => sei ← NextVisibleSe[sei];
ENDCASE;
RETURN [HashForSe[sei]]};
FillNull: PROC RETURNS [Tree.Link] = {RETURN [Tree.Null]};
nL ← ArrangeKeys[son[1], NextKey, FillNull]}
ELSE {
nL ← ListLength[son[1]];
son[1] ← FreeTree[UpdateList[son[1], PushItem]];
IF nL > nR AND type # typeANY THEN Log.ErrorN[listLong, nL-nR];
THROUGH (nL .. nR] DO PushTree[Tree.Null] ENDLOOP;
nL ← MAX[nL, nR]};
PushTree[UpdateList[MakeList[nR], AssignItem]];
PushNode[exlist, 1]; SetInfo[type]; son[1] ← PopTree[];
RPush[type, attr]; phraseNP ← saveNP;
P3S.implicit ← saveImplicit; implicitRecord ← saveRecord};
ExtractorRhs:
PROC [t: Tree.Link]
RETURNS [v: Tree.Link] =
INLINE {
SELECT OpName[t]
FROM
apply => {
node: Tree.Index = Apply[GetNode[t], typeANY, FALSE];
tb[node].info ← RType[]; v ← [subtree[node]]};
signalx, errorx, joinx, startx => {
PushTree[MiscXfer[GetNode[t], typeANY]]; SetInfo[RType[]]; v ← PopTree[]};
ENDCASE => v ← Exp[t, typeANY];
RETURN};
self: PUBLIC P3S.SelfInfo;
Dot:
PUBLIC
PROC [node: Tree.Index, target: CSEIndex]
RETURNS [Tree.Index] = {
IF DotExpr[node].selfAppl
THEN {
saveSelf: P3S.SelfInfo = self;
v: Tree.Link = tb[node].son[2];
self ← [tree: tb[node].son[1], type: RType[], attr: RAttr[], np: phraseNP];
RPop[]; tb[node].son[1] ← tb[node].son[2] ← Tree.Null; FreeNode[node];
node ← GetNode[Exp[ApplyToSelf[v, Tree.Null, Tree.Null], target]];
self ← saveSelf};
RETURN [node]};
DotExpr:
PROC [node: Tree.Index]
RETURNS [selfAppl:
BOOL ←
FALSE] = {
OPEN tb[node];
type, lType, rType: CSEIndex;
sei: ISEIndex;
fieldHti: HTIndex = GetHash[son[2]];
attr: Attr;
nDerefs: CARDINAL ← 0;
son[1] ← Exp[son[1], typeANY]; type ← lType ← RType[]; attr ← RAttr[]; RPop[];
N.B. failure is avoided only by EXITing the following loop
DO
nType: CSEIndex = NormalType[type];
WITH t: seb[nType]
SELECT
FROM
record => {
nHits: CARDINAL;
[nHits, sei] ← FieldId[fieldHti, LOOPHOLE[nType, RecordSEIndex]];
SELECT nHits
FROM
0 => {
matched: BOOL;
[matched, sei] ← ClusterId[fieldHti, ClusterForType[nType]];
IF matched
AND XferMode[seb[sei].idType] # none
THEN {
name ← cdot; selfAppl ← TRUE; attr2 ← FALSE;
son[2] ← [symbol[sei]]; rType ← lType;
attr.const ← ConstantId[sei];
EXIT};
IF Bundling[nType] = 0 THEN GO TO nomatch};
1 => {
long: BOOL ← LongPath[son[1]];
counted: BOOL ← TRUE;
WHILE lType # type
DO
-- rederive path, update tree
subType: CSEIndex = NormalType[lType];
WITH s: seb[subType]
SELECT
FROM
ref => {
long ← seb[lType].typeTag = long;
lType ← UnderType[s.refType];
IF ~(s.counted OR PermanentType[s.refType]) THEN counted ← FALSE;
IF nDerefs > 1
OR lType # type
THEN {
son[1] ← Dereference[son[1], lType, long]; nDerefs ← nDerefs-1}};
record => {
lType ← Unbundle[LOOPHOLE[subType, RecordSEIndex]];
son[1] ← ForceType[son[1], lType]};
ENDCASE;
ENDLOOP;
IF nDerefs = 0 THEN name ← dollar;
attr2 ← long;
IF ~attr.const AND ConstantId[sei] THEN {name ← cdot; attr.const ← TRUE};
IF P3S.safety = checked
AND ~counted
THEN
Log.ErrorNode[unsafeOperation, node];
son[2] ← [symbol[sei]]; rType ← UnderType[seb[sei].idType];
EXIT};
ENDCASE => GO TO ambiguous;
type ← Unbundle[LOOPHOLE[nType, RecordSEIndex]]};
opaque, enumerated, relative => {
matched: BOOL;
[matched, sei] ← ClusterId[fieldHti, ClusterForType[nType]];
IF matched
AND XferMode[seb[sei].idType] # none
THEN {
name ← cdot; selfAppl ← TRUE; attr2 ← FALSE;
son[2] ← [symbol[sei]]; rType ← lType;
attr.const ← ConstantId[sei];
EXIT};
GO TO nomatch};
ref => {
IF (nDerefs ← nDerefs+1) > 63 THEN GO TO nomatch;
type ← UnderType[t.refType]; attr.const ← FALSE};
definition, transfer =>
IF ([sei: sei]←InterfaceId[fieldHti, InterfaceCtx[nType, son[1]]]).found
THEN {
name ← cdot; son[2] ← [symbol[sei]]; attr2 ← FALSE;
rType ← type ← UnderType[seb[sei].idType];
attr.const ← ConstantId[sei];
IF VarType[type]
OR (
ctxb[seb[sei].idCtx].ctxType = imported
AND ~dataPtr.interface
AND TypeForm[type] = ref) THEN {
rType ← ReferentType[type]; son[2] ← Dereference[son[2], rType, FALSE]};
EXIT}
ELSE GOTO nomatch;
mode => {
rType ← NormalType[UnderType[TypeForTree[tb[node].son[1]]]];
WITH t: seb[rType]
SELECT
FROM
enumerated =>
IF ([sei: sei]←SearchCtxList[fieldHti, t.valueCtx]).found
THEN
name ← cdot
ELSE GOTO nomatch;
record => {
sei ← SelectVariantType[rType, fieldHti];
rType ← typeTYPE; name ← discrimTC};
ENDCASE => GO TO nomatch;
son[2] ← [symbol[sei]]; attr2 ← FALSE; attr.const ← TRUE; EXIT};
ENDCASE => GO TO nomatch;
REPEAT
nomatch => {
son[2] ← [symbol[dataPtr.seAnon]];
IF son[1] # son[2]
AND fieldHti # HTNull
THEN
Log.ErrorHti[unknownField, fieldHti];
rType ← typeANY; attr ← emptyAttr};
ambiguous => {
Log.ErrorHti[ambiguousId, fieldHti];
son[2] ← [symbol[dataPtr.seAnon]];
rType ← typeANY; attr ← emptyAttr};
ENDLOOP;
tb[node].info ← rType; RPush[rType, attr]; RETURN};
Apply:
PUBLIC
PROC [node: Tree.Index, target: CSEIndex, mustXfer:
BOOL]
RETURNS [Tree.Index] = {
opType, type: CSEIndex;
attr: Attr;
leftNP: NPUse;
long: BOOL;
nDerefs: CARDINAL ← 0;
indirect: BOOL ← FALSE;
string, desc: BOOL ← FALSE;
saveSelf: P3S.SelfInfo = self;
ForceDirect:
PROC = {
IF indirect
THEN
tb[node].son[1] ← Dereference[tb[node].son[1], opType, long];
indirect ← FALSE};
IF tb[node].son[1] # Tree.Null
THEN {
IF OpName[tb[node].son[1]] = dot AND ~tb[node].attr1 THEN node ← DotApply[node]
ELSE
WITH t: seb[target]
SELECT
FROM
union => {
PushCtx[t.caseCtx]; tb[node].son[1] ← Exp[tb[node].son[1], typeANY]; PopCtx[]};
ENDCASE => tb[node].son[1] ← Exp[tb[node].son[1], typeANY];
opType ← RType[]; attr ← RAttr[]; leftNP ← phraseNP; RPop[];
IF opType = typeTYPE THEN type ← UnderType[TypeForTree[tb[node].son[1]]]}
ELSE {
opType ← typeTYPE;
SELECT seb[target].typeTag
FROM
record => type ← UnderType[TypeRoot[target]];
array => type ← target;
ENDCASE => {type ← CSENull; Log.ErrorNode[noTarget, node]}};
long ← LongPath[tb[node].son[1]];
dereferencing/deproceduring loop
DO
OPEN tb[node];
nType: CSEIndex = NormalType[opType];
WITH t: seb[nType]
SELECT
FROM
mode => {
ForceDirect[];
SELECT TypeForm[NormalType[type]]
FROM
record => Construct[node, LOOPHOLE[type, RecordSEIndex]];
array => RowCons[node, LOOPHOLE[type, ArraySEIndex]];
enumerated, basic => {
temp: Tree.Link = son[1];
IF UniOperand[node] THEN son[2] ← Rhs[son[2], TargetType[type]];
attr ← And[RAttr[], attr]; phraseNP ← MergeNP[leftNP][phraseNP]; RPop[];
son[1] ← son[2]; son[2] ← temp;
name ← check; RPush[type, attr]};
ENDCASE => ApplyError[node, type # CSENull];
EXIT};
transfer => {
mode: TransferMode = t.mode;
OpName:
ARRAY TransferMode
OF Tree.NodeName = [
proc: callx, port: portcallx, signal: signalx, error: errorx,
process: joinx, program: startx, none: apply];
ForceDirect[];
SELECT mode
FROM
proc =>
IF ~P3S.currentBody.lockHeld
AND OperandInternal[son[1]]
THEN
Log.ErrorTree[internalCall, son[1]];
program =>
IF BodyForTree[son[1]] # CBTNull THEN Log.ErrorTree[typeClash, son[1]];
port => IF long THEN Log.ErrorTree[long, son[1]];
ENDCASE;
IF t.typeIn = CSENull
THEN
son[2] ← MatchFields[RecordSENull, son[2], FALSE, FALSE]
ELSE
WITH in: seb[t.typeIn]
SELECT
FROM
record =>
son[2] ←
IF attr1
THEN Rhs[son[2], t.typeIn]
ELSE MatchFields[LOOPHOLE[t.typeIn], son[2], FALSE, mode=program];
ENDCASE => {
Log.ErrorTree[typeClash, son[1]];
son[2] ← MatchFields[RecordSENull, son[2], FALSE, FALSE]};
name ← OpName[mode];
attr ← And[RAttr[], attr]; phraseNP ← MergeNP[leftNP][phraseNP];
RPop[];
IF P3S.safety = checked
THEN
IF ~(t.safe
OR mode = error)
OR mode = port
OR mode = process
THEN
Log.ErrorNode[unsafeOperation, node];
IF mode = proc THEN attr ← CheckInline[node, attr]
ELSE {attr.noXfer ← attr.noAssign ← FALSE; phraseNP ← SetNP[phraseNP]};
attr.const ← FALSE; RPush[t.typeOut, attr];
EXIT};
array => {
ForceDirect[];
IF UniOperand[node]
THEN
tb[node].son[2] ← Rhs[tb[node].son[2], TargetType[UnderType[t.indexType]]];
attr ← And[RAttr[], attr]; phraseNP ← MergeNP[leftNP][phraseNP]; RPop[];
RPush[UnderType[t.componentType], attr];
name ← SELECT TRUE FROM string => seqindex, desc => dindex, ENDCASE => index;
attr2 ← long;
IF mustXfer THEN {opType ← ForceXfer[node]; mustXfer ← FALSE} -- to avoid looping
ELSE EXIT};
sequence => {
ForceDirect[];
IF UniOperand[node]
THEN
tb[node].son[2] ← Rhs[tb[node].son[2], TargetType[UnderType[seb[t.tagSei].idType]]];
attr ← And[RAttr[], attr]; phraseNP ← MergeNP[leftNP][phraseNP]; RPop[];
RPush[UnderType[t.componentType], attr];
name ← seqindex; attr2 ← long;
IF mustXfer THEN {opType ← ForceXfer[node]; mustXfer ← FALSE} -- to avoid looping
ELSE EXIT};
arraydesc => {
ForceDirect[];
long ← seb[opType].typeTag = long;
opType ← UnderType[t.describedType]; attr.const ← FALSE; desc ← TRUE;
IF P3S.safety = checked THEN Log.ErrorNode[unsafeOperation, node]};
ref => {
subType: CSEIndex;
SELECT
TRUE
FROM
t.basing => {
ForceDirect[];
IF UniOperand[node] THEN tb[node].son[2] ← Rhs[tb[node].son[2], typeANY];
attr ← And[RAttr[], attr]; phraseNP ← MergeNP[leftNP][phraseNP];
subType ← CanonicalType[RType[]]; RPop[];
WITH r: seb[subType]
SELECT
FROM
relative => {
IF ~Types.Assignable[[own, UnderType[r.baseType]], [own, opType]]
THEN
Log.ErrorTree[typeClash, son[1]];
type ← UnderType[r.resultType]};
ENDCASE => {
type ← typeANY;
IF subType # typeANY THEN Log.ErrorTree[typeClash, son[2]]};
subType ← NormalType[type];
attr1 ← TypeForm[subType] = arraydesc;
attr2 ← TypeForm[opType] = long OR TypeForm[type] = long;
WITH r: seb[subType]
SELECT
FROM
ref => type ← UnderType[r.refType];
arraydesc => type ← UnderType[r.describedType];
ENDCASE;
attr.const ← FALSE; RPush[type, attr]; name ← reloc;
IF P3S.safety = checked THEN Log.ErrorNode[unsafeOperation, node];
IF mustXfer THEN {opType ← ForceXfer[node]; mustXfer ← FALSE} -- to avoid looping
ELSE EXIT};
ENDCASE => {
subType ← UnderType[t.refType]; attr.const ← FALSE;
WITH r: seb[subType]
SELECT
FROM
record =>
IF ctxb[r.fieldCtx].level = lG
THEN {
ForceDirect[];
opType ← XferForFrame[r.fieldCtx];
IF opType = CSENull THEN GO TO fail;
son[1] ← ForceType[son[1], opType]}
ELSE GO TO deRef;
ENDCASE => GO TO deRef;
EXITS
deRef => {
IF (nDerefs ← nDerefs+1) > 63 THEN GO TO fail;
IF indirect THEN ForceDirect[];
IF P3S.safety = checked
AND ~(t.counted
OR PermanentType[t.refType])
THEN
Log.ErrorNode[unsafeOperation, node];
indirect ← TRUE; long ← seb[opType].typeTag = long;
opType ← subType}}};
record => {
rSei: RecordSEIndex = LOOPHOLE[nType];
sei: ISEIndex = SequenceField[rSei];
SELECT
TRUE
FROM
(sei # ISENull) => {
PushSe[sei];
opType ← UnderType[seb[sei].idType];
PushTree[son[1]];
PushNode[IF indirect THEN dot ELSE dollar, -2];
SetInfo[opType]; SetAttr[2, long];
son[1] ← PopTree[]; indirect ← FALSE};
(rSei = dataPtr.typeStringBody) => {
textSei: ISEIndex = NextSe[NextSe[FirstVisibleSe[seb[rSei].fieldCtx]]];
PushSe[textSei];
attr.const ← FALSE; string ← TRUE; opType ← UnderType[seb[textSei].idType];
PushTree[son[1]];
PushNode[IF indirect THEN dot ELSE dollar, -2]; SetInfo[opType]; SetAttr[2, long];
son[1] ← PopTree[]; indirect ← FALSE};
(rSei = dataPtr.typeCONDITION) => {
ForceDirect[];
IF son[2] # Tree.Null THEN Log.ErrorN[listLong, ListLength[son[2]]];
RPush[CSENull, attr];
name ← wait; phraseNP ← SetNP[phraseNP];
EXIT};
(Bundling[rSei] # 0) => {
ForceDirect[]; opType ← Unbundle[rSei]; son[1] ← ForceType[son[1], opType]};
ENDCASE => GO TO fail};
ENDCASE => GO TO fail;
REPEAT
fail => ApplyError[node, opType#typeANY OR nDerefs#0];
ENDLOOP;
IF tb[node].nSons > 2
THEN {
saveNP: NPUse = phraseNP;
SELECT tb[node].name
FROM
callx, portcallx, signalx, errorx, startx, fork, joinx, wait, apply => NULL;
ENDCASE => Log.Error[misplacedCatch];
[] ← CatchPhrase[tb[node].son[3]]; phraseNP ← MergeNP[saveNP][phraseNP]};
IF tb[node].attr1
THEN
SELECT tb[node].name
FROM
callx, portcallx, signalx, errorx, startx, fork, joinx, apply => NULL;
reloc => NULL;
ENDCASE => Log.ErrorTree[typeClash, tb[node].son[1]];
IF RType[] = CSENull
THEN
tb[node].name ←
SELECT tb[node].name
FROM
callx => call,
portcallx => portcall,
signalx => signal,
errorx => error,
startx => start,
joinx => join,
ENDCASE => tb[node].name;
self ← saveSelf;
RETURN [node]};
UniOperand:
PROC [node: Tree.Index]
RETURNS [unit:
BOOL] = {
unit ← (ListLength[tb[node].son[2]] = 1);
IF ~unit
THEN {
CheckLength[tb[node].son[2], 1];
tb[node].son[2] ← UpdateList[tb[node].son[2], VoidExp];
RPush[typeANY, emptyAttr]}
ELSE IF KeyedList[tb[node].son[2]] THEN Log.Error[keys]};
ApplyError:
PROC [node: Tree.Index, warn:
BOOL] = {
IF warn THEN Log.ErrorTree[noApplication, tb[node].son[1]];
tb[node].son[2] ← UpdateList[tb[node].son[2], VoidExp];
RPush[typeANY, emptyAttr]};
ForceXfer:
PROC [node: Tree.Index]
RETURNS [opType: CSEIndex] = {
opType ← RType[]; RPop[];
IF tb[node].nSons > 2 THEN Log.Error[misplacedCatch];
PushTree[tb[node].son[1]]; PushTree[tb[node].son[2]];
PushNode[tb[node].name, 2]; SetInfo[opType]; SetAttr[2, tb[node].attr2];
SetAttr[1, tb[node].attr1]; tb[node].attr1 ← FALSE;
tb[node].son[1] ← PopTree[]; tb[node].son[2] ← Tree.Null;
tb[node].name ← apply; RETURN};
DotApply:
PROC [node: Tree.Index]
RETURNS [Tree.Index] = {
subNode: Tree.Index = GetNode[tb[node].son[1]];
IF DotExpr[subNode].selfAppl
THEN {
op: Tree.Link = tb[subNode].son[2];
args: Tree.Link = tb[node].son[2];
catch: Tree.Link;
tb[node].son[2] ← Tree.Null;
IF tb[node].nSons > 2 THEN {catch ← tb[node].son[3]; tb[node].son[3] ← Tree.Null}
ELSE catch ← Tree.Null;
self ← [tree:tb[subNode].son[1], type:RType[], attr:RAttr[], np:phraseNP];
tb[subNode].son[1] ← tb[subNode].son[2] ← Tree.Null;
RPop[]; FreeNode[node];
node ← GetNode[ApplyToSelf[op, args, catch]];
tb[node].son[1] ← Exp[tb[node].son[1], typeANY]};
RETURN [node]};
ApplyToSelf:
PROC [op, args, catch: Tree.Link]
RETURNS [Tree.Link] = {
n: CARDINAL ← 1;
PushArg: Tree.Map = {PushTree[t]; n ← n+1; RETURN [Tree.Null]};
PushTree[op];
IF KeyedList[args]
THEN {
sei: ISEIndex = FirstCtxSe[ArgCtx[TransferTypes[OperandType[op]].typeIn]];
PushHash[IF sei # ISENull THEN seb[sei].hash ELSE HTNull];
PushNode[self, 0]; PushNode[item, 2]}
ELSE PushNode[self, 0];
args ← FreeTree[UpdateList[args, PushArg]];
PushList[n];
IF catch = Tree.Null THEN PushNode[apply, 2]
ELSE {PushTree[catch]; PushNode[apply, 3]};
SetInfo[dataPtr.textIndex]; SetAttr[1, FALSE];
RETURN [PopTree[]]};
Construct:
PROC [node: Tree.Index, type: RecordSEIndex, init:
BOOL ←
FALSE] = {
OPEN tb[node];
cType: CSEIndex ← type;
attr: Attr;
t: Tree.Link;
son[2] ← MatchFields[type, son[2], init]; attr ← RAttr[]; RPop[];
WITH r: seb[type]
SELECT
FROM
linked => {name ← union; cType ← VariantUnionType[r.linkType]};
ENDCASE => {
name ← construct;
IF r.hints.variant
AND (t←ListTail[son[2]]) # Tree.Null
THEN
cType ← DiscriminatedType[type, t]};
info ← cType; RPush[cType, attr]};
RowCons:
PROC [node: Tree.Index, aType: ArraySEIndex] = {
OPEN tb[node];
componentType: SEIndex = seb[aType].componentType;
iType: CSEIndex = UnderType[seb[aType].indexType];
cType: CSEIndex = TargetType[UnderType[componentType]];
attr: Attr ← fullAttr;
exitNP: NPUse ← none;
MapValue: Tree.Map = {
type: CSEIndex;
subAttr: Attr;
v ←
SELECT
TRUE
FROM
(t = Tree.Null) => DefaultInit[componentType],
(OpName[t] = void) => FieldVoid[t],
ENDCASE => Rhs[t, cType];
subAttr ← RAttr[]; type ← RType[]; RPop[];
IF v = Tree.Null THEN VoidComponent[componentType];
IF P3S.safety = checked
AND TypeForm[type] = transfer
THEN
v ← CheckScope[v, type];
exitNP ← MergeNP[exitNP][phraseNP]; attr ← And[attr, subAttr]; RETURN};
IF KeyedList[son[2]]
OR (son[2] = Tree.Null
AND TypeForm[TargetType[iType]] = enumerated)
THEN {
keyType: CSEIndex = TargetType[iType];
vCtx: CTXIndex;
first, last, i: Copier.SEToken;
hti: HTIndex;
NextKey:
PROC
RETURNS [HTIndex] = {
IF i = last THEN hti ← HTNull
ELSE {
i ← IF i = Copier.nullSEToken THEN first ELSE Copier.CtxNext[vCtx, i];
hti ← KeyForHash[Copier.TokenHash[vCtx, i]]};
RETURN [hti]};
OmittedValue:
PROC
RETURNS [t: Tree.Link] = {
IF Default[componentType] # none THEN t ← Tree.Null
ELSE {Log.ErrorHti[omittedKey, hti]; t ← [symbol[dataPtr.seAnon]]};
RETURN};
WITH t: seb[keyType]
SELECT
FROM
enumerated => {
vCtx ← t.valueCtx;
[first, last] ← Span[iType];
IF first # Copier.nullSEToken
AND last # Copier.nullSEToken
AND Copier.TokenValue[vCtx, first] <= Copier.TokenValue[vCtx, last]
THEN {
i ← Copier.nullSEToken;
son[2] ← PopKeyList[ArrangeKeys[son[2], NextKey, OmittedValue]]}
ELSE Log.Error[keys]};
ENDCASE => Log.Error[keys]};
son[2] ← UpdateList[son[2], MapValue];
name ← rowcons; info ← aType; RPush[aType, attr]; phraseNP ← exitNP};
All:
PUBLIC
PROC [node: Tree.Index, target: CSEIndex, init:
BOOL ←
FALSE] = {
OPEN tb[node];
t: Tree.Link = son[1];
l: CARDINAL = ListLength[t];
attr: Attr;
SELECT l
FROM
0, 1 => {
WITH seb[target]
SELECT
FROM
array => {
cType: CSEIndex = TargetType[UnderType[componentType]];
type: CSEIndex;
son[1] ←
SELECT
TRUE
FROM
(t = Tree.Null) => --IF init THEN-- DefaultInit[componentType],
(OpName[t] = void) => FieldVoid[t],
ENDCASE => Rhs[t, cType];
type ← RType[]; attr ← RAttr[]; RPop[];
IF son[1] = Tree.Null THEN VoidComponent[componentType];
IF P3S.safety = checked
AND TypeForm[type] = transfer
THEN
son[1] ← CheckScope[son[1], type];
attr.const ← FALSE};
ENDCASE => {
Log.ErrorNode[noTarget, node]; son[1] ← VoidExp[son[1]]; attr ← emptyAttr}};
ENDCASE => {
Log.ErrorN[listLong, l-1]; son[1] ← UpdateList[son[1], VoidExp]; attr ← emptyAttr};
info ← target; RPush[target, attr]};
VoidComponent:
PROC [type: SEIndex] = {
IF ~Voidable[type]
THEN
Log.ErrorSei[elision, IF seb[type].seTag = id THEN LOOPHOLE[type] ELSE dataPtr.seAnon]};
CheckInline:
PROC [node: Tree.Index, attr: Attr]
RETURNS [Attr] = {
bti: CBTIndex = BodyForTree[tb[node].son[1]];
IF bti = CBTNull
THEN {
P3S.currentBody.noXfers ← attr.noXfer ← FALSE;
attr.noAssign ← FALSE; phraseNP ← SetNP[phraseNP]}
ELSE {
IF ~bb[bti].inline THEN P3S.currentBody.noXfers ← attr.noXfer ← FALSE
ELSE
WITH body: bb[bti].info
SELECT
FROM
Internal => {
SELECT OpName[tb[node].son[1]]
FROM
dot, dollar => Log.ErrorTree[misusedInline, tb[node].son[1]];
ENDCASE;
PushTree[tb[node].son[1]];
PushTree[[subtree[index: body.thread]]];
PushNode[thread, 2]; SetAttr[1, FALSE]; SetInfo[P3S.currentScope];
tb[node].son[1] ← PopTree[];
body.thread ← node; MarkShared[[subtree[node]], TRUE];
tb[node].attr3 ← --attr.noXfer AND-- attr.noAssign;
IF ~bb[bti].noXfers
THEN
P3S.currentBody.noXfers ← attr.noXfer ← FALSE};
ENDCASE => ERROR;
IF ~bb[bti].hints.safe
THEN {
attr.noAssign ← FALSE; phraseNP ← SetNP[phraseNP]}};
RETURN [attr]};
InterfaceCtx:
PUBLIC
PROC [type: CSEIndex, v: Tree.Link]
RETURNS [ctx: CTXIndex] = {
WITH t: seb[type]
SELECT
FROM
definition => ctx ← t.defCtx;
transfer => {
bti: CBTIndex = BodyForTree[v];
ctx ←
IF bti = CBTNull
OR t.mode # program
THEN CTXNull ELSE bb[bti].localCtx};
ENDCASE => ctx ← CTXNull;
RETURN};
}.