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, ErrorNodeOp, ErrorSei, ErrorTree, ErrorTreeOp],
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, Type, ISEIndex, CSEIndex, ArraySEIndex, RecordSEIndex, ContextLevel, CTXIndex, CBTIndex, TransferMode, HTNull, ISENull, nullType, CSENull, RecordSENull, CTXNull, CBTNull, lG, typeANY, typeTYPE, bodyType, ctxType, seType],
SymbolOps: TYPE USING [ArgCtx, ConstantId, CtxLevel, EqTypes, 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, OpaqueValue];
KeyedList:
PUBLIC
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:
PUBLIC 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: Type]
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[seb[sei].idType, IF v=Tree.Null THEN voidAttr ELSE UpdateTreeAttr[v]];
RETURN};
FieldVoid:
PUBLIC 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: Type;
IF sei # ISENull
AND ~(seb[sei].public
OR init
OR Shared[ctx])
THEN
Log.ErrorSei[privateId, 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: Type = TargetType[IF sei=ISENull THEN typeANY ELSE seb[sei].idType];
v ← IF init THEN Initialization[t, target] 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 = RecordSENull 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: Type, 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: Type]
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]
Initialization:
PUBLIC
PROC[t: Tree.Link, type: Type]
RETURNS[v: Tree.Link] = {
SELECT TypeForm[type]
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: Type;
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 {
IF P3S.safety=checked
AND AssignableType[lhsType,
FALSE]
THEN
Log.ErrorTreeOp[unsafeOp, son[1], assignx]
ELSE Log.ErrorTreeOp[missingOp, son[1], assignx]};
SELECT TypeForm[lhsType]
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.ErrorTreeOp[missingOp, son[2], assignx];
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: Type;
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: Type = P3S.implicit.type;
IF sei # ISENull
AND ~seb[sei].public
AND ~Shared[ctx]
THEN
Log.ErrorSei[privateId, 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 = nullType THEN {nR ← 0; sei ← ISENull}
ELSE {
rSei: CSEIndex = UnderType[TypeRoot[type]];
WITH seb[rSei]
SELECT
FROM
record => {
CompleteRecord[LOOPHOLE[rSei, RecordSEIndex]];
IF ContextComplete[fieldCtx]
THEN {
implicitRecord ← LOOPHOLE[rSei, 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: Type]
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: Type;
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[type]];
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 GOTO 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 ← (TypeForm[lType] = $long);
lType ← 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]};
opaque => {
lType ← Types.OpaqueValue[[own, nType], own].sei;
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.ErrorNodeOp[unsafeOp, node, uparrow];
son[2] ← [symbol[sei]]; rType ← seb[sei].idType;
EXIT};
ENDCASE => GOTO 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};
IF TypeForm[nType] # $opaque THEN GOTO nomatch;
type ← Types.OpaqueValue[[own, nType], own].sei;
IF type = nType THEN GOTO nomatch};
ref => {
IF (nDerefs ← nDerefs+1) > 63 THEN GOTO nomatch;
type ← 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 ← 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 => {
subType: CSEIndex;
rType ← TypeForTree[tb[node].son[1]]; subType ← NormalType[rType];
WITH t: seb[subType]
SELECT
FROM
enumerated =>
IF ([sei: sei]←SearchCtxList[fieldHti, t.valueCtx]).found
THEN
name ← cdot
ELSE GOTO nomatch;
record => {
sei ← SelectVariantType[subType, fieldHti];
rType ← typeTYPE; name ← discrimTC};
ENDCASE => GOTO nomatch;
son[2] ← [symbol[sei]]; attr2 ← FALSE; attr.const ← TRUE; EXIT};
ENDCASE => GOTO 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: Type, mustXfer:
BOOL]
RETURNS[Tree.Index] = {
opType, type: Type;
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]; attr.const ← FALSE};
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 {
sei: CSEIndex = UnderType[target];
WITH t: seb[sei]
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 ← TypeForTree[tb[node].son[1]]}
ELSE {
opType ← typeTYPE;
SELECT TypeForm[target]
FROM
$record => type ← TypeRoot[target];
$array => type ← target;
ENDCASE => {type ← nullType; 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 => {
subType: CSEIndex = NormalType[type];
ForceDirect[];
SELECT TypeForm[NormalType[type]]
FROM
$record => Construct[node, LOOPHOLE[subType, RecordSEIndex]];
$array => RowCons[node, LOOPHOLE[subType, 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 # nullType];
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[longPath, 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.ErrorTreeOp[missingOp, son[1], apply];
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[t.indexType]];
attr ← And[RAttr[], attr]; phraseNP ← MergeNP[leftNP][phraseNP]; RPop[];
RPush[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[seb[t.tagSei].idType]];
attr ← And[RAttr[], attr]; phraseNP ← MergeNP[leftNP][phraseNP]; RPop[];
RPush[t.componentType, attr];
name ← seqindex; attr2 ← long;
IF mustXfer THEN {opType ← ForceXfer[node]; mustXfer ← FALSE} -- to avoid looping
ELSE EXIT};
arraydesc => {
ForceDirect[];
long ← (TypeForm[opType] = $long);
opType ← 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 ← UnderType[CanonicalType[RType[]]]; RPop[];
WITH r: seb[subType]
SELECT
FROM
relative => {
IF ~Types.Assignable[[own, UnderType[r.baseType]], [own, UnderType[opType]]]
THEN
Log.ErrorTree[typeClash, son[1]];
type ← 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 ← r.refType;
arraydesc => type ← 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 CtxLevel[r.fieldCtx] = lG
THEN {
ForceDirect[];
opType ← XferForFrame[r.fieldCtx];
IF opType = nullType THEN GOTO fail;
son[1] ← ForceType[son[1], opType]}
ELSE GOTO deRef;
ENDCASE => GOTO deRef;
EXITS
deRef => {
IF (nDerefs ← nDerefs+1) > 63 THEN GOTO fail;
IF indirect THEN ForceDirect[];
IF P3S.safety = checked
AND ~(t.counted
OR PermanentType[t.refType])
THEN
Log.ErrorNodeOp[unsafeOp, node, uparrow];
indirect ← TRUE; long ← (TypeForm[opType] = $long);
opType ← t.refType}}};
record => {
rSei: RecordSEIndex = LOOPHOLE[nType];
sei: ISEIndex = SequenceField[rSei];
SELECT
TRUE
FROM
(sei # ISENull) => {
PushSe[sei];
opType ← 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 ← 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[nullType, attr];
name ← wait; phraseNP ← SetNP[phraseNP];
EXIT};
(Bundling[rSei] # 0) => {
ForceDirect[]; opType ← Unbundle[rSei]; son[1] ← ForceType[son[1], opType]};
ENDCASE => GOTO fail};
opaque => {
opType ← Types.OpaqueValue[[own, nType], own].sei;
IF EqTypes[opType, nType] THEN GOTO fail;
son[1] ← ForceType[son[1], opType]};
ENDCASE => GOTO 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.ErrorTreeOp[missingOp, tb[node].son[1], apply];
IF RType[] = nullType
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: Type] = {
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: Type = seb[aType].componentType;
iType: CSEIndex = UnderType[seb[aType].indexType];
cType: Type = TargetType[componentType];
attr: Attr ← fullAttr;
exitNP: NPUse ← none;
MapValue: Tree.Map = {
type: Type;
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 = UnderType[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: Type, init:
BOOL ←
FALSE] = {
OPEN tb[node];
t: Tree.Link = son[1];
l: CARDINAL = ListLength[t];
attr: Attr;
SELECT l
FROM
0, 1 => {
sei: CSEIndex = UnderType[target];
WITH a: seb[sei]
SELECT
FROM
array => {
cType: Type = TargetType[a.componentType];
type: Type;
son[1] ←
SELECT
TRUE
FROM
(t = Tree.Null) => --IF init THEN-- DefaultInit[a.componentType],
(OpName[t] = void) => FieldVoid[t],
ENDCASE => Rhs[t, cType];
type ← RType[]; attr ← RAttr[]; RPop[];
IF son[1] = Tree.Null THEN VoidComponent[a.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:
PUBLIC PROC[type: Type] = {
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};
}.