Pass3Xa.mesa
Copyright Ó 1985, 1986, 1987, 1989, 1991, 1993 by Xerox Corporation. All rights reserved.
Satterthwaite, June 17, 1986 2:51:21 pm PDT
Russ Atkinson (RRA) September 12, 1989 2:07:56 pm PDT
Willie-s, March 11, 1993 6:54 pm PST
DIRECTORY
Alloc USING [Notifier],
MimData USING [checks, interface, mainCtx, seAnon, textIndex, typeCONDITION, typeStringBody],
MimosaCopier USING [CtxNext, nullSEToken, SEToken, TokenHash, TokenValue],
MimosaLog USING [Error, ErrorHti, ErrorN, ErrorNode, ErrorNodeOp, ErrorSei, ErrorTree, ErrorTreeOp, ErrorType, WarningTree],
MimP3 USING [And, ArrangeKeys, Attr, CatchPhrase, ClearType, ClusterId, CompleteRecord, CopyTree, DiscriminatedType, emptyAttr, EnterComposite, Exp, FieldId, ForceType, fullAttr, InterfaceId, MainIncludedCtx, MergeNP, MiscXfer, NPUse, PopCtx, PushCtx, RAttr, RAttrPop, Rhs, RPop, RPush, RType, SearchCtxList, SelectVariantType, SequenceField, SetNP, SetType, Shared, Span, UpdateTreeAttr, VariantUnionType, voidAttr, VoidExp, XferForFrame],
MimP3S USING [currentBody, currentScope, implicit, ImplicitInfo, safety, SelfInfo],
Pass3Attributes USING [AssignableType, BodyForTree, Bundling, CanonicalType, Default, DefaultInit, LongPath, LongType, OperandEntry, OperandInternal, OperandLevel, OperandLhs, OperandType, PermanentType, TargetType, TypeForTree, Unbundle, VarType, Voidable, VoidItem],
SymbolOps USING [ArgCtx, ConstantId, CtxLevel, DecodeBitAddr, EqTypes, FindExtension, FirstCtxSe, FirstVisibleSe, FromBti, FromType, NextSe, NextVisibleSe, NormalType, own, RCType, ReferentType, TransferTypes, TypeForm, TypeRoot, UnderType, VisibleCtxEntries, XferMode],
Symbols USING [ArraySEIndex, Base, bodyType, CBTIndex, CBTNull, ContextLevel, CSEIndex, CSENull, CTXIndex, CTXNull, ctxType, HTIndex, HTNull, ISEIndex, ISENull, lG, nullType, RecordSEIndex, RecordSENull, seType, TransferMode, Type, typeANY, typeTYPE],
Tree USING [Base, Index, Link, Map, NodeName, Null, Scan, treeType],
TreeOps USING [FreeNode, FreeTree, FromLoc, GetHash, GetNode, GetTag, ListHead, ListLength, ListTail, MakeList, MakeNode, MarkShared, NthSon, OpName, PopTree, PushHash, PushList, PushNode, PushProperList, PushSe, PushTree, ScanList, SetAttr, SetInfo, UpdateList],
Types USING [Assignable, OpaqueValue];
Pass3Xa: PROGRAM
IMPORTS MimData, MimosaCopier, MimosaLog, MimP3, MimP3S, Pass3Attributes, SymbolOps, TreeOps, Types
EXPORTS MimP3, MimP3S = {
OPEN MimP3, Pass3Attributes, Symbols, TreeOps;
options
checkArgRecord: BOOL ¬ TRUE;
exported variables
phraseNP: PUBLIC NPUse ¬ none;
exported to MimP3
implicitRecord: PUBLIC RecordSEIndex ¬ RecordSENull;
exported to MimP3S
self: PUBLIC MimP3S.SelfInfo ¬ [Tree.Null, nullType, MimP3.emptyAttr, none];
exported to MimP3S
expression list manipulation
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[]};
};
CheckLength: PUBLIC PROC [t: Tree.Link, length: INTEGER] = {
n: INTEGER = ListLength[t];
SELECT n FROM
= length => RETURN;
> length => MimosaLog.ErrorN[listLong, n-length];
< length => MimosaLog.ErrorN[listShort, length-n];
ENDCASE;
};
ContextComplete: PROC [ctx: CTXIndex] RETURNS [BOOL] = INLINE {
WITH cx: ctxb[ctx] SELECT FROM
simple => RETURN [TRUE];
included => RETURN [cx.complete];
ENDCASE => RETURN [FALSE];
};
CheckScope: PUBLIC PROC [t: Tree.Link, type: Type] RETURNS [v: Tree.Link] = {
v ¬ t;
SELECT SymbolOps.XferMode[SymbolOps.own, type] FROM
$proc =>
SELECT OperandLevel[t] FROM
global => {};
local => MimosaLog.ErrorTree[scopeFault, t];
ENDCASE => {PushTree[t]; PushNode[proccheck, 1]; SetType[type]; v ¬ PopTree[]};
ENDCASE;
};
KeyForHash: PROC [hti: HTIndex] RETURNS [HTIndex] = INLINE {
RETURN [IF hti = HTNull THEN seb[MimData.seAnon].hash ELSE hti];
};
HashForSe: PROC [sei: ISEIndex] RETURNS [HTIndex] = INLINE {
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 ¬ SymbolOps.FirstVisibleSe[ctx];
added: BOOL ¬ FALSE;
nFields: CARDINAL ¬ 0;
PushField: Tree.Map = {
PushTree[t];
nFields ¬ nFields + 1;
sei ¬ SymbolOps.NextSe[SymbolOps.own, sei];
RETURN [Tree.Null];
};
[] ¬ FreeTree[UpdateList[expList, PushField]];
UNTIL sei = ISENull DO
IF NOT seb[sei].extended
AND (seb[record].argument OR Default[seb[sei].idType] = none) THEN
EXIT;
PushTree[Tree.Null];
added ¬ TRUE;
nFields ¬ nFields + 1;
sei ¬ SymbolOps.NextSe[SymbolOps.own, 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[SymbolOps.FindExtension[SymbolOps.own, sei].tree, CheckOption];
RPush[seb[sei].idType, IF v=Tree.Null THEN voidAttr ELSE UpdateTreeAttr[v]];
};
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, scopeCheck: BOOL]
RETURNS [val: Tree.Link] = {
nFields: CARDINAL;
ctx: CTXIndex;
sei: ISEIndex ¬ ISENull;
attr: Attr ¬ fullAttr;
exitNP: NPUse ¬ none;
EvaluateField: Tree.Map = {
subAttr: Attr;
type: Type;
IF sei # ISENull AND NOT (seb[sei].public OR init OR Shared[ctx]) THEN
MimosaLog.ErrorSei[privateId, sei];
SELECT TRUE FROM
(t = Tree.Null) =>
v ¬ SELECT TRUE FROM
(sei = ISENull) => FieldVoid[t],
(seb[sei].extended) => FieldDefault[sei],
(argRecord) => 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];
};
type ¬ RType[];
subAttr ¬ RAttrPop[];
SELECT TRUE FROM
v # Tree.Null => {};
sei = ISENull => {};
RRA: this is new, why did omitting it work for PrincOps?
argRecord AND checkArgRecord =>
new check to help avoid trash as arguments
MimosaLog.ErrorSei[elision, sei];
seb[sei].extended AND VoidItem[SymbolOps.FindExtension[SymbolOps.own, sei].tree] => {
OK to void
};
NOT seb[sei].extended AND Voidable[seb[sei].idType] => {
OK to void
};
ENDCASE => MimosaLog.ErrorSei[elision, sei];
IF scopeCheck AND MimP3S.safety = checked THEN
IF SymbolOps.TypeForm[SymbolOps.own, type] = $transfer THEN
v ¬ CheckScope[v, type];
attr ¬ And[attr, subAttr];
exitNP ¬ MergeNP[exitNP][phraseNP];
sei ¬ SymbolOps.NextSe[SymbolOps.own, sei];
};
argRecord: BOOL ¬ FALSE;
IF record = RecordSENull
THEN CheckLength[expList, 0]
ELSE {
argRecord ¬ seb[record].argument;
CompleteRecord[record];
IF NOT ContextComplete[seb[record].fieldCtx]
THEN {
IF seb[record].hints.privateFields THEN MimosaLog.Error[noAccess];
}
ELSE {
ctx ¬ seb[record].fieldCtx;
IF KeyedList[expList]
THEN {
sei: ISEIndex;
started: BOOL ¬ FALSE;
NextKey: PROC RETURNS [HTIndex] = {
SELECT TRUE FROM
NOT started => {sei ¬ SymbolOps.FirstVisibleSe[ctx]; started ¬ TRUE};
(sei # ISENull) => sei ¬ SymbolOps.NextVisibleSe[sei];
ENDCASE;
RETURN [HashForSe[sei]];
};
OmittedValue: PROC RETURNS [t: Tree.Link ¬ Tree.Null] = {
IF NOT seb[sei].extended
AND (seb[record].argument OR Default[seb[sei].idType] = none)
THEN {
MimosaLog.ErrorHti[omittedKey, seb[sei].hash];
t ¬ [symbol[MimData.seAnon]];
};
};
nFields ¬ ArrangeKeys[expList, NextKey, OmittedValue];
expList ¬ PopKeyList[nFields];
}
ELSE {
nFields ¬ SymbolOps.VisibleCtxEntries[ctx];
IF ListLength[expList] < nFields THEN expList ¬ PadList[record, expList];
CheckLength[expList, nFields];
};
sei ¬ SymbolOps.FirstVisibleSe[ctx];
};
};
val ¬ UpdateList[expList, EvaluateField];
RPush[record, attr];
phraseNP ¬ exitNP;
};
Dereference: PROC [t: Tree.Link, type: Type, long: BOOL] RETURNS [Tree.Link] = {
PushTree[t];
PushNode[uparrow, 1];
SetType[type];
SetAttr[2, long];
RETURN [PopTree[]];
};
ClusterForType: PROC [type: Type] RETURNS [CTXIndex] = {
DO
subType: CSEIndex = SymbolOps.UnderType[SymbolOps.own, type];
ctx: CTXIndex ¬ CTXNull;
WITH t: seb[subType] SELECT FROM
enumerated => ctx ¬ t.valueCtx;
record => IF NOT t.argument THEN ctx ¬ t.fieldCtx;
ref => {type ¬ t.refType; LOOP};
relative => {type ¬ t.offsetType; LOOP};
subrange => {type ¬ t.rangeType; LOOP};
opaque => RETURN [seb[t.id].idCtx];
ENDCASE => RETURN [CTXNull];
IF ctx # CTXNull THEN
WITH c: ctxb[ctx] SELECT FROM
simple => IF MimData.interface THEN RETURN [MimData.mainCtx];
included => RETURN [MainIncludedCtx[c.module]];
ENDCASE;
RETURN [CTXNull];
ENDLOOP;
};
operators
Initialization: PUBLIC PROC [t: Tree.Link, type: Type] RETURNS [v: Tree.Link] = {
SELECT SymbolOps.TypeForm[SymbolOps.own, type] FROM
$record =>
IF OpName[t] = apply
THEN Construct[GetNode[t], LOOPHOLE[type], TRUE]
ELSE GO TO rhs;
$union =>
IF OpName[t] = apply
THEN {
subType: CSEIndex = SymbolOps.UnderType[SymbolOps.own, TypeForTree[NthSon[t, 1]]];
WITH seb[subType] SELECT FROM
record => Construct[GetNode[t], LOOPHOLE[subType], TRUE];
ENDCASE => GO TO rhs;
}
ELSE GO TO rhs;
$array =>
IF OpName[t] = all
THEN All[GetNode[t], type, TRUE]
ELSE GO TO rhs;
ENDCASE => GO TO rhs;
v ¬ t;
EXITS rhs => v ¬ Rhs[t, type];
};
Assignment: PUBLIC PROC [node: Tree.Index] = {
son1: Tree.Link ¬ tb[node].son[1] ¬ Exp[tb[node].son[1], typeANY];
saveNP: NPUse ¬ phraseNP;
lhsType: Type ¬ RType[];
attr: Attr ¬ RAttrPop[];
son2: Tree.Link ¬ tb[node].son[2] ¬ Rhs[tb[node].son[2], TargetType[lhsType]];
rhsType: Type ¬ RType[];
attr ¬ And[RAttrPop[], attr];
attr.noAssign ¬ FALSE;
phraseNP ¬ MergeNP[phraseNP][saveNP];
RPush[rhsType, attr];
IF NOT AssignableType[lhsType, MimP3S.safety=checked] THEN {
IF MimP3S.safety=checked AND AssignableType[lhsType, FALSE]
THEN MimosaLog.ErrorTreeOp[unsafeOp, son1, assignx]
ELSE MimosaLog.ErrorTreeOp[missingOp, son1, assignx];
};
SELECT SymbolOps.TypeForm[SymbolOps.own, lhsType] FROM
$transfer => IF MimP3S.safety = checked THEN
son2 ¬ tb[node].son[2] ¬ CheckScope[son2, rhsType];
$union =>
IF NOT Types.Assignable[
[SymbolOps.own, DiscriminatedType[typeANY, son1]],
[SymbolOps.own, DiscriminatedType[typeANY, son2]]] THEN
MimosaLog.ErrorTree[typeClash, son2];
$sequence =>
MimosaLog.ErrorTreeOp[missingOp, son2, assignx];
ENDCASE;
tb[node].attr1 ¬ FALSE;
SELECT OperandLhs[son1] FROM
counted =>
SELECT SymbolOps.RCType[SymbolOps.own, lhsType] FROM
simple => {tb[node].attr2 ¬ TRUE; tb[node].attr3 ¬ FALSE};
composite => {
tb[node].attr2 ¬ tb[node].attr3 ¬ TRUE;
EnterComposite[lhsType, son2, FALSE];
};
ENDCASE => tb[node].attr2 ¬ FALSE;
none => MimosaLog.ErrorTree[nonLHS, son1];
ENDCASE => tb[node].attr2 ¬ FALSE;
};
Extract: PUBLIC PROC [node: Tree.Index] = {
type: Type ¬ typeANY;
attr: Attr;
ctx: CTXIndex;
sei: ISEIndex ¬ ISENull;
nL, nR: CARDINAL ¬ 0;
saveImplicit: MimP3S.ImplicitInfo = MimP3S.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 = MimP3S.implicit.type;
IF sei # ISENull AND NOT seb[sei].public AND NOT Shared[ctx] THEN
MimosaLog.ErrorSei[privateId, sei];
IF t = Tree.Null
THEN v ¬ Tree.Null
ELSE {
MimP3S.implicit.type ¬ IF sei = ISENull THEN typeANY ELSE SymbolOps.UnderType[SymbolOps.own, 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[RAttrPop[], attr];
saveNP ¬ MergeNP[saveNP][phraseNP];
};
sei ¬ SymbolOps.NextSe[SymbolOps.own, sei];
MimP3S.implicit.type ¬ saveType;
};
MimP3S.implicit.tree ¬ tb[node].son[2] ¬ ExtractorRhs[tb[node].son[2]];
type ¬ RType[]; MimP3S.implicit.attr ¬ attr ¬ RAttrPop[];
saveNP ¬ phraseNP;
IF type # nullType THEN {
rSei: CSEIndex = SymbolOps.UnderType[SymbolOps.own, SymbolOps.TypeRoot[SymbolOps.own, type]];
WITH seb[rSei] SELECT FROM
record => {
CompleteRecord[LOOPHOLE[rSei, RecordSEIndex]];
IF ContextComplete[fieldCtx]
THEN {
implicitRecord ¬ LOOPHOLE[rSei, RecordSEIndex];
ctx ¬ fieldCtx;
sei ¬ SymbolOps.FirstVisibleSe[ctx];
nR ¬ SymbolOps.VisibleCtxEntries[ctx];
}
ELSE {MimosaLog.Error[noAccess]; type ¬ typeANY};
};
ENDCASE => {MimosaLog.ErrorTree[typeClash, tb[node].son[2]]; type ¬ typeANY};
};
IF KeyedList[tb[node].son[1]] AND nR # 0
THEN {
sei: ISEIndex ¬ ISENull;
started: BOOL ¬ FALSE;
NextKey: PROC RETURNS [HTIndex] = {
SELECT TRUE FROM
NOT started => {sei ¬ SymbolOps.FirstVisibleSe[ctx]; started ¬ TRUE};
(sei # ISENull) => sei ¬ SymbolOps.NextVisibleSe[sei];
ENDCASE;
RETURN [HashForSe[sei]];
};
FillNull: PROC RETURNS [Tree.Link] = {
RETURN [Tree.Null];
};
nL ¬ ArrangeKeys[tb[node].son[1], NextKey, FillNull];
}
ELSE {
nL ¬ ListLength[tb[node].son[1]];
tb[node].son[1] ¬ FreeTree[UpdateList[tb[node].son[1], PushItem]];
IF nL > nR AND type # typeANY THEN MimosaLog.ErrorN[listLong, nL-nR];
THROUGH (nL .. nR] DO PushTree[Tree.Null] ENDLOOP;
nL ¬ MAX[nL, nR];
};
PushTree[UpdateList[MakeList[nR], AssignItem]];
PushNode[exlist, 1]; SetType[type]; tb[node].son[1] ¬ PopTree[];
RPush[type, attr]; phraseNP ¬ saveNP;
MimP3S.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 ¬ SymbolOps.FromType[RType[]];
v ¬ [subtree[node]];
};
signalx, errorx, joinx, startx => {
PushTree[MiscXfer[GetNode[t], typeANY]];
SetType[RType[]];
v ¬ PopTree[];
};
ENDCASE => v ¬ Exp[t, typeANY];
};
Dot: PUBLIC PROC [node: Tree.Index, target: Type] RETURNS [Tree.Index] = {
IF DotExpr[node].selfAppl THEN {
saveSelf: MimP3S.SelfInfo = self;
v: Tree.Link = tb[node].son[2];
type: Type = RType[];
attr: Attr = RAttrPop[];
self ¬ [tree: tb[node].son[1], type: type, attr: attr, np: phraseNP];
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] = {
sei: ISEIndex;
son2: Tree.Link ¬ tb[node].son[2];
fieldHti: HTIndex = GetHash[son2];
nDerefs: CARDINAL ¬ 0;
son1: Tree.Link ¬ tb[node].son[1] ¬ Exp[tb[node].son[1], typeANY];
initType: Type ¬ RType[];
type: Type ¬ initType;
lType: Type ¬ initType;
rType: Type ¬ initType;
attr: Attr ¬ RAttrPop[];
N.B. failure is avoided only by EXITing the following loop
FOR count: NAT ¬ 0, count+1 DO
nType: CSEIndex = SymbolOps.NormalType[SymbolOps.own, type];
IF count > 64 THEN GO TO circular;
WITH t: seb[nType] SELECT FROM
record => {
nHits: NAT;
[nHits, sei] ¬ FieldId[fieldHti, LOOPHOLE[nType, RecordSEIndex]];
SELECT nHits FROM
0 => {
matched: BOOL;
[matched, sei] ¬ ClusterId[fieldHti, ClusterForType[type]];
IF matched THEN
IF SymbolOps.XferMode[SymbolOps.own, seb[sei].idType] # $none THEN {
tb[node].name ¬ cdot;
selfAppl ¬ TRUE;
tb[node].attr2 ¬ FALSE;
son2 ¬ tb[node].son[2] ¬ [symbol[sei]];
rType ¬ lType;
attr.const ¬ SymbolOps.ConstantId[sei];
EXIT;
};
IF Bundling[nType] = 0 THEN GO TO nomatch;
};
1 => {
long: BOOL ¬ LongPath[son1];
counted: BOOL ¬ TRUE;
funny: BOOL ¬ FALSE;
uType: CSEIndex = SymbolOps.NormalType[SymbolOps.own, type];
DO
rederive path, update tree
subType: CSEIndex = SymbolOps.NormalType[SymbolOps.own, lType];
IF uType = subType THEN EXIT;
Look for equivalence after identifier stripping
WITH s: seb[subType] SELECT FROM
ref => {
lType ¬ s.refType;
long ¬ LongType[lType];
IF NOT (s.counted OR PermanentType[lType]) THEN counted ¬ FALSE;
IF nDerefs > 1 OR lType # type THEN {
son1 ¬ tb[node].son[1] ¬ Dereference[son1, lType, long];
nDerefs ¬ nDerefs-1;
};
};
record => {
lType ¬ Unbundle[LOOPHOLE[subType, RecordSEIndex]];
son1 ¬ tb[node].son[1] ¬ ForceType[son1, lType];
};
opaque => {
lType ¬ Types.OpaqueValue[[SymbolOps.own, subType], SymbolOps.own].sei;
son1 ¬ tb[node].son[1] ¬ ForceType[son1, lType];
};
ENDCASE => {
funny ¬ TRUE;
EXIT;
};
ENDLOOP;
IF nDerefs = 0 THEN tb[node].name ¬ dollar;
tb[node].attr2 ¬ long;
IF NOT attr.const AND SymbolOps.ConstantId[sei] THEN {
tb[node].name ¬ cdot;
attr.const ¬ TRUE;
};
WITH s1: son1 SELECT TreeOps.GetTag[son1] FROM
string => IF SymbolOps.DecodeBitAddr[seb[sei].idValue].bd = 0 THEN
We can handle the length only!
attr.const ¬ TRUE;
ENDCASE;
IF MimP3S.safety = checked AND NOT counted THEN
MimosaLog.ErrorNodeOp[unsafeOp, node, uparrow];
son2 ¬ tb[node].son[2] ¬ [symbol[sei]];
rType ¬ 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 THEN
IF SymbolOps.XferMode[SymbolOps.own, seb[sei].idType] # $none THEN {
tb[node].name ¬ cdot;
selfAppl ¬ TRUE;
tb[node].attr2 ¬ FALSE;
son2 ¬ tb[node].son[2] ¬ [symbol[sei]];
rType ¬ lType;
attr.const ¬ SymbolOps.ConstantId[sei];
EXIT;
};
IF SymbolOps.TypeForm[SymbolOps.own, nType] # $opaque THEN GO TO nomatch;
type ¬ Types.OpaqueValue[[SymbolOps.own, nType], SymbolOps.own].sei;
IF type = nType THEN GO TO nomatch;
};
ref => {
IF (nDerefs ¬ nDerefs+1) > 16 THEN GO TO nomatch;
type ¬ t.refType;
attr.const ¬ FALSE;
};
definition, transfer => {
found: BOOL;
[sei: sei, found: found] ¬ InterfaceId[fieldHti, InterfaceCtx[nType, son1]];
IF NOT found THEN GO TO nomatch;
tb[node].name ¬ cdot;
son2 ¬ tb[node].son[2] ¬ [symbol[sei]];
tb[node].attr2 ¬ FALSE;
rType ¬ type ¬ seb[sei].idType;
attr.const ¬ SymbolOps.ConstantId[sei];
IF VarType[type] OR (
ctxb[seb[sei].idCtx].ctxType = imported
AND NOT MimData.interface
AND SymbolOps.TypeForm[SymbolOps.own, type] = $ref) THEN {
rType ¬ SymbolOps.ReferentType[SymbolOps.own, type];
son2 ¬ tb[node].son[2] ¬ Dereference[son2, rType, FALSE];
};
EXIT;
};
mode => {
subType: CSEIndex;
rType ¬ TypeForTree[son1];
subType ¬ SymbolOps.NormalType[SymbolOps.own, rType];
WITH t: seb[subType] SELECT FROM
enumerated => {
found: BOOL;
[sei: sei, found: found] ¬ SearchCtxList[fieldHti, t.valueCtx];
IF NOT found THEN GO TO nomatch;
tb[node].name ¬ cdot;
};
record => {
sei ¬ SelectVariantType[subType, fieldHti];
rType ¬ typeTYPE;
tb[node].name ¬ discrimTC;
};
ENDCASE => GO TO nomatch;
son2 ¬ tb[node].son[2] ¬ [symbol[sei]];
tb[node].attr2 ¬ FALSE;
attr.const ¬ TRUE;
EXIT;
};
ENDCASE => GO TO nomatch;
REPEAT
circular => {
MimosaLog.ErrorType[circularType, son1, [SymbolOps.own, initType]];
son2 ¬ tb[node].son[2] ¬ [symbol[MimData.seAnon]];
rType ¬ typeANY;
attr ¬ emptyAttr;
};
nomatch => {
son2 ¬ tb[node].son[2] ¬ [symbol[MimData.seAnon]];
IF son1 # son2 AND fieldHti # HTNull THEN
MimosaLog.ErrorHti[unknownField, fieldHti];
rType ¬ typeANY;
attr ¬ emptyAttr;
};
ambiguous => {
MimosaLog.ErrorHti[ambiguousId, fieldHti];
son2 ¬ tb[node].son[2] ¬ [symbol[MimData.seAnon]];
rType ¬ typeANY;
attr ¬ emptyAttr;
};
ENDLOOP;
tb[node].info ¬ SymbolOps.FromType[rType];
RPush[rType, attr];
};
Apply: PUBLIC PROC
[node: Tree.Index, target: Type, mustXfer: BOOL] RETURNS [Tree.Index] = {
opType: Type ¬ nullType;
type: Type ¬ nullType;
attr: Attr;
leftNP: NPUse;
long: BOOL ¬ FALSE;
nDerefs: CARDINAL ¬ 0;
indirect: BOOL ¬ FALSE;
string: BOOL ¬ FALSE;
desc: BOOL ¬ FALSE;
saveSelf: MimP3S.SelfInfo = self;
son1: Tree.Link ¬ tb[node].son[1];
ForceDirect: PROC = {
IF indirect THEN {
son1 ¬ tb[node].son[1] ¬ Dereference[tb[node].son[1], opType, long];
attr.const ¬ FALSE;
indirect ¬ FALSE;
};
};
IF son1 # Tree.Null
THEN {
IF OpName[son1] = dot AND NOT tb[node].attr1
THEN {
subNode: Tree.Index = GetNode[son1];
IF DotExpr[subNode].selfAppl THEN {
Rewrite Foo.Bar[...] into CLUSTER[Foo].Bar[Foo, ...]
op: Tree.Link = tb[subNode].son[2];
args: Tree.Link = tb[node].son[2];
catch: Tree.Link ¬ Tree.Null;
type: Type = RType[];
attr: Attr = RAttrPop[];
tb[node].son[2] ¬ Tree.Null;
IF tb[node].nSons > 2 THEN {
catch ¬ tb[node].son[3];
tb[node].son[3] ¬ Tree.Null;
};
self ¬ [tree: tb[subNode].son[1], type: type, attr: attr, np: phraseNP];
tb[subNode].son[1] ¬ tb[subNode].son[2] ¬ Tree.Null;
FreeNode[node];
node ¬ GetNode[ApplyToSelf[op, args, catch]];
son1 ¬ Exp[tb[node].son[1], typeANY];
};
}
ELSE {
sei: CSEIndex = SymbolOps.UnderType[SymbolOps.own, target];
WITH t: seb[sei] SELECT FROM
union => {
PushCtx[t.caseCtx];
son1 ¬ Exp[son1, typeANY];
PopCtx[];
};
ENDCASE => son1 ¬ Exp[son1, typeANY];
};
tb[node].son[1] ¬ son1;
opType ¬ RType[];
attr ¬ RAttrPop[];
leftNP ¬ phraseNP;
IF opType = typeTYPE THEN type ¬ TypeForTree[son1];
}
ELSE {
opType ¬ typeTYPE;
SELECT SymbolOps.TypeForm[SymbolOps.own, target] FROM
$record => type ¬ SymbolOps.TypeRoot[SymbolOps.own, target];
$array => type ¬ target;
ENDCASE => {type ¬ nullType; MimosaLog.ErrorNode[noTarget, node];
};
};
long ¬ LongPath[son1];
dereferencing/deproceduring loop
DO
nType: CSEIndex = SymbolOps.NormalType[SymbolOps.own, opType];
WITH t: seb[nType] SELECT FROM
mode => {
subType: CSEIndex = SymbolOps.NormalType[SymbolOps.own, type];
ForceDirect[];
SELECT seb[subType].typeTag FROM
$record => Construct[node, LOOPHOLE[subType, RecordSEIndex]];
$array => RowCons[node, LOOPHOLE[subType, ArraySEIndex]];
$enumerated, $basic, $signed, $unsigned, $real => {
son1: Tree.Link = tb[node].son[1];
son2: Tree.Link ¬ tb[node].son[2];
IF UniOperand[node] THEN {
son2 ¬ tb[node].son[2] ¬ Rhs[son2, TargetType[type]];
SELECT seb[ClearType[OperandType[son2]]].typeTag FROM
mode => MimosaLog.ErrorTree[typeClash, son2];
ENDCASE;
};
attr ¬ And[RAttrPop[], attr];
phraseNP ¬ MergeNP[leftNP][phraseNP];
tb[node].son[1] ¬ son2;
tb[node].son[2] ¬ son1;
tb[node].name ¬ check;
RPush[type, attr];
};
ENDCASE => ApplyError[node, type # nullType];
son1 ¬ tb[node].son[1];
EXIT;
};
transfer => {
mode: TransferMode = t.mode;
OpName: ARRAY TransferMode OF Tree.NodeName = [
proc: callx, port: portcallx, signal: signalx, error: errorx,
process: joinx, program: startx, other: apply, none: apply];
ForceDirect[];
SELECT mode FROM
proc =>
IF MimP3S.currentBody.lockHeld
THEN {
IF MimData.checks['e] AND OperandEntry[son1] THEN
MimosaLog.WarningTree[doubleEntry, son1 ];
}
ELSE {
IF OperandInternal[son1] THEN
MimosaLog.ErrorTree[internalCall, son1];
};
program =>
IF BodyForTree[tb[node].son[1]] # CBTNull THEN
MimosaLog.ErrorTree[typeClash, tb[node].son[1]];
port => IF long THEN MimosaLog.ErrorTree[longPath, tb[node].son[1]];
ENDCASE;
IF t.typeIn = CSENull
THEN
tb[node].son[2] ¬ MatchFields[
record: RecordSENull, expList: tb[node].son[2],
init: FALSE, scopeCheck: FALSE]
ELSE
WITH in: seb[t.typeIn] SELECT FROM
record =>
tb[node].son[2] ¬ IF tb[node].attr1
THEN Rhs[tb[node].son[2], t.typeIn]
ELSE MatchFields[
record: LOOPHOLE[t.typeIn], expList: tb[node].son[2],
init: FALSE, scopeCheck: mode=program];
ENDCASE => {
MimosaLog.ErrorTreeOp[missingOp, tb[node].son[1], apply];
tb[node].son[2] ¬ MatchFields[
record: RecordSENull, expList: tb[node].son[2],
init: FALSE, scopeCheck: FALSE];
};
tb[node].name ¬ OpName[mode];
attr ¬ And[RAttrPop[], attr];
phraseNP ¬ MergeNP[leftNP][phraseNP];
IF MimP3S.safety = checked THEN
IF NOT (t.safe OR mode = error) OR mode = port OR mode = process THEN
MimosaLog.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[RAttrPop[], attr];
phraseNP ¬ MergeNP[leftNP][phraseNP];
RPush[t.componentType, attr];
tb[node].name ¬ SELECT TRUE FROM
string => seqindex, desc => dindex,
ENDCASE => index;
tb[node].attr2 ¬ long;
IF NOT mustXfer THEN EXIT;
opType ¬ ForceXfer[node];
mustXfer ¬ FALSE; -- to avoid looping
};
sequence => {
ForceDirect[];
IF UniOperand[node] THEN
tb[node].son[2] ¬ Rhs[tb[node].son[2], TargetType[seb[t.tagSei].idType]];
attr ¬ And[RAttrPop[], attr];
phraseNP ¬ MergeNP[leftNP][phraseNP];
RPush[t.componentType, attr];
tb[node].name ¬ seqindex;
tb[node].attr2 ¬ long;
IF NOT mustXfer THEN EXIT;
opType ¬ ForceXfer[node];
mustXfer ¬ FALSE; -- to avoid looping
};
arraydesc => {
ForceDirect[];
long ¬ LongType[opType];
opType ¬ t.describedType;
attr.const ¬ FALSE;
desc ¬ TRUE;
IF MimP3S.safety = checked THEN MimosaLog.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 ¬ SymbolOps.UnderType[
SymbolOps.own, CanonicalType[RType[]]];
RPop[];
WITH r: seb[subType] SELECT FROM
relative => {
IF NOT Types.Assignable[
[SymbolOps.own, SymbolOps.UnderType[SymbolOps.own, r.baseType]],
[SymbolOps.own, SymbolOps.UnderType[SymbolOps.own, opType]]] THEN
MimosaLog.ErrorTree[typeClash, tb[node].son[1]];
type ¬ r.resultType;
};
ENDCASE => {
type ¬ typeANY;
IF subType # typeANY THEN
MimosaLog.ErrorTree[typeClash, tb[node].son[2]];
};
subType ¬ SymbolOps.NormalType[SymbolOps.own, type];
tb[node].attr1 ¬ (SymbolOps.TypeForm[SymbolOps.own, subType] = $arraydesc);
tb[node].attr2 ¬ LongType[opType] OR LongType[type];
WITH r: seb[subType] SELECT FROM
ref => type ¬ r.refType;
arraydesc => type ¬ r.describedType;
ENDCASE;
attr.const ¬ FALSE;
RPush[type, attr];
tb[node].name ¬ reloc;
IF MimP3S.safety = checked THEN MimosaLog.ErrorNode[unsafeOperation, node];
IF NOT mustXfer THEN EXIT;
opType ¬ ForceXfer[node];
mustXfer ¬ FALSE;
};
ENDCASE => {
subType ¬ SymbolOps.UnderType[SymbolOps.own, t.refType];
attr.const ¬ FALSE;
WITH r: seb[subType] SELECT FROM
record =>
IF SymbolOps.CtxLevel[SymbolOps.own, r.fieldCtx] = lG
THEN {
ForceDirect[];
opType ¬ XferForFrame[r.fieldCtx];
IF opType = nullType THEN GO TO fail;
tb[node].son[1] ¬ ForceType[tb[node].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 MimP3S.safety = checked
AND NOT (t.counted OR PermanentType[t.refType]) THEN
MimosaLog.ErrorNodeOp[unsafeOp, node, uparrow];
indirect ¬ TRUE;
long ¬ LongType[opType];
opType ¬ t.refType;
};
};
};
record => {
rSei: RecordSEIndex = LOOPHOLE[nType];
sei: ISEIndex = SequenceField[rSei];
SELECT TRUE FROM
(sei # ISENull) => {
PushSe[sei];
opType ¬ seb[sei].idType;
PushTree[tb[node].son[1]];
PushNode[IF indirect THEN dot ELSE dollar, -2];
SetType[opType]; SetAttr[2, long];
tb[node].son[1] ¬ PopTree[];
indirect ¬ FALSE;
};
(rSei = MimData.typeStringBody) => {
textSei: ISEIndex = SymbolOps.NextSe[SymbolOps.own,
SymbolOps.NextSe[SymbolOps.own, SymbolOps.FirstVisibleSe[seb[rSei].fieldCtx]]];
PushSe[textSei];
attr.const ¬ FALSE;
string ¬ TRUE;
opType ¬ seb[textSei].idType;
PushTree[tb[node].son[1]];
PushNode[IF indirect THEN dot ELSE dollar, -2];
SetType[opType]; SetAttr[2, long];
tb[node].son[1] ¬ PopTree[];
indirect ¬ FALSE;
};
(rSei = MimData.typeCONDITION) => {
ForceDirect[];
IF tb[node].son[2] # Tree.Null THEN
MimosaLog.ErrorN[listLong, ListLength[tb[node].son[2]]];
RPush[nullType, attr];
tb[node].name ¬ wait;
phraseNP ¬ SetNP[phraseNP];
EXIT;
};
(Bundling[rSei] # 0) => {
ForceDirect[];
opType ¬ Unbundle[rSei];
tb[node].son[1] ¬ ForceType[tb[node].son[1], opType];
};
ENDCASE => GO TO fail;
};
opaque => {
opType ¬ Types.OpaqueValue[[SymbolOps.own, nType], SymbolOps.own].sei;
IF SymbolOps.EqTypes[SymbolOps.own, opType, nType] THEN GO TO fail;
tb[node].son[1] ¬ ForceType[tb[node].son[1], opType];
};
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 => MimosaLog.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 => MimosaLog.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] = {
son2: Tree.Link ¬ tb[node].son[2];
unit ¬ (ListLength[son2] = 1);
SELECT TRUE FROM
NOT unit => {
CheckLength[son2, 1];
tb[node].son[2] ¬ UpdateList[son2, VoidExp];
RPush[typeANY, emptyAttr];
};
KeyedList[son2] => MimosaLog.Error[keys];
ENDCASE;
};
ApplyError: PROC [node: Tree.Index, warn: BOOL] = {
IF warn THEN MimosaLog.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 MimosaLog.Error[misplacedCatch];
PushTree[tb[node].son[1]];
PushTree[tb[node].son[2]];
PushNode[tb[node].name, 2];
SetType[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;
};
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 = SymbolOps.FirstCtxSe[SymbolOps.own, SymbolOps.ArgCtx[SymbolOps.own, SymbolOps.TransferTypes[SymbolOps.own, 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[FromLoc[MimData.textIndex]]; SetAttr[1, FALSE];
RETURN [PopTree[]];
};
Construct: PROC [node: Tree.Index, type: RecordSEIndex, init: BOOL ¬ FALSE] = {
cType: CSEIndex ¬ type;
son2: Tree.Link ¬ tb[node].son[2] ¬ MatchFields[
record: type, expList: tb[node].son[2], init: init, scopeCheck: TRUE];
attr: Attr ¬ RAttrPop[];
WITH r: seb[type] SELECT FROM
linked => {tb[node].name ¬ union; cType ¬ VariantUnionType[r.linkType]};
ENDCASE => {
tb[node].name ¬ construct;
IF r.hints.variant THEN {
t: Tree.Link = ListTail[son2];
IF t # Tree.Null THEN cType ¬ DiscriminatedType[type, t];
};
};
tb[node].info ¬ SymbolOps.FromType[cType];
RPush[cType, attr];
};
RowCons: PROC [node: Tree.Index, aType: ArraySEIndex] = {
componentType: Type = seb[aType].componentType;
iType: CSEIndex = SymbolOps.UnderType[SymbolOps.own, 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];
type ¬ RType[];
subAttr ¬ RAttrPop[];
IF v = Tree.Null THEN VoidComponent[componentType];
IF MimP3S.safety = checked
AND SymbolOps.TypeForm[SymbolOps.own, type] = $transfer THEN
v ¬ CheckScope[v, type];
exitNP ¬ MergeNP[exitNP][phraseNP];
attr ¬ And[attr, subAttr];
};
son2: Tree.Link ¬ tb[node].son[2];
IF KeyedList[son2]
OR (son2 = Tree.Null AND
SymbolOps.TypeForm[SymbolOps.own, TargetType[iType]] = $enumerated) THEN {
keyType: CSEIndex = SymbolOps.UnderType[SymbolOps.own, TargetType[iType]];
vCtx: CTXIndex;
first, last, i: MimosaCopier.SEToken ¬ MimosaCopier.nullSEToken;
hti: HTIndex ¬ HTNull;
NextKey: PROC RETURNS [HTIndex] = {
ht: HTIndex ¬ HTNull;
IF i # last THEN {
IF i = MimosaCopier.nullSEToken
THEN i ¬ first
ELSE i ¬ MimosaCopier.CtxNext[vCtx, i];
ht ¬ KeyForHash[MimosaCopier.TokenHash[vCtx, i]];
};
hti ¬ ht;
RETURN [ht];
};
OmittedValue: PROC RETURNS [Tree.Link] = {
IF Default[componentType] # none THEN RETURN [Tree.Null];
MimosaLog.ErrorHti[omittedKey, hti];
RETURN [[symbol[MimData.seAnon]]];
};
WITH t: seb[keyType] SELECT FROM
enumerated => {
vCtx ¬ t.valueCtx;
[first, last] ¬ Span[iType];
IF first = MimosaCopier.nullSEToken THEN GO TO keyError;
IF last = MimosaCopier.nullSEToken THEN GO TO keyError;
IF MimosaCopier.TokenValue[vCtx, first]
> MimosaCopier.TokenValue[vCtx, last] THEN GO TO keyError;
i ¬ MimosaCopier.nullSEToken;
son2 ¬ PopKeyList[ArrangeKeys[son2, NextKey, OmittedValue]];
tb[node].son[2] ¬ son2;
};
ENDCASE => GO TO keyError;
EXITS keyError => MimosaLog.Error[keys];
};
son2 ¬ tb[node].son[2] ¬ UpdateList[son2, MapValue];
tb[node].name ¬ rowcons;
tb[node].info ¬ SymbolOps.FromType[aType];
RPush[aType, attr];
phraseNP ¬ exitNP;
};
All: PUBLIC PROC [node: Tree.Index, target: Type, init: BOOL ¬ FALSE] = {
son1: Tree.Link ¬ tb[node].son[1];
len: CARDINAL = ListLength[son1];
attr: Attr ¬ emptyAttr;
SELECT len FROM
0, 1 => {
sei: CSEIndex = SymbolOps.UnderType[SymbolOps.own, target];
WITH a: seb[sei] SELECT FROM
array => {
cType: Type = TargetType[a.componentType];
type: Type;
son1 ¬ tb[node].son[1] ¬ SELECT TRUE FROM
(son1 = Tree.Null) => --IF init THEN-- DefaultInit[a.componentType],
(OpName[son1] = void) => FieldVoid[son1],
ENDCASE => Rhs[son1, cType];
type ¬ RType[];
attr ¬ RAttrPop[];
IF son1 = Tree.Null THEN VoidComponent[a.componentType];
IF MimP3S.safety = checked
AND SymbolOps.TypeForm[SymbolOps.own, type] = $transfer THEN
son1 ¬ tb[node].son[1] ¬ CheckScope[son1, type];
attr.const ¬ FALSE;
};
ENDCASE => {
MimosaLog.ErrorNode[noTarget, node];
son1 ¬ tb[node].son[1] ¬ VoidExp[son1];
};
};
ENDCASE => {
MimosaLog.ErrorN[listLong, len-1];
son1 ¬ tb[node].son[1] ¬ UpdateList[son1, VoidExp];
};
tb[node].info ¬ SymbolOps.FromType[target];
RPush[target, attr];
};
VoidComponent: PUBLIC PROC [type: Type] = {
IF NOT Voidable[type] THEN
MimosaLog.ErrorSei[
elision,
IF seb[type].seTag = id THEN LOOPHOLE[type] ELSE MimData.seAnon];
};
CheckInline: PROC [node: Tree.Index, attr: Attr] RETURNS [Attr] = {
bti: CBTIndex = BodyForTree[tb[node].son[1]];
IF bti = CBTNull
THEN {
MimP3S.currentBody.noXfers ¬ attr.noXfer ¬ FALSE;
attr.noAssign ¬ FALSE;
phraseNP ¬ SetNP[phraseNP];
}
ELSE {
IF NOT bb[bti].inline
THEN MimP3S.currentBody.noXfers ¬ attr.noXfer ¬ FALSE
ELSE
WITH body: bb[bti].info SELECT FROM
Internal => {
SELECT OpName[tb[node].son[1]] FROM
dot, dollar => MimosaLog.ErrorTree[misusedInline, tb[node].son[1]];
ENDCASE;
PushTree[tb[node].son[1]];
PushTree[[subtree[index: body.thread]]];
PushNode[thread, 2]; SetAttr[1, FALSE];
SetInfo[SymbolOps.FromBti[MimP3S.currentScope]];
tb[node].son[1] ¬ PopTree[];
body.thread ¬ node;
MarkShared[[subtree[node]], TRUE];
tb[node].attr3 ¬ --attr.noXfer AND-- attr.noAssign;
IF NOT bb[bti].noXfers THEN
MimP3S.currentBody.noXfers ¬ attr.noXfer ¬ FALSE;
};
ENDCASE => ERROR;
IF NOT bb[bti].hints.safe THEN {
attr.noAssign ¬ FALSE;
phraseNP ¬ SetNP[phraseNP];
};
};
RETURN [attr];
};
InterfaceCtx: PUBLIC PROC [type: CSEIndex, v: Tree.Link] RETURNS [ctx: CTXIndex] = {
ctx ¬ CTXNull;
WITH t: seb[type] SELECT FROM
definition => ctx ¬ t.defCtx;
transfer => {
bti: CBTIndex = BodyForTree[v];
IF bti # CBTNull AND t.mode = program THEN ctx ¬ bb[bti].localCtx;
};
ENDCASE;
};
table bases & notifier
tb: Tree.Base ¬ NIL; -- tree base address (local copy)
seb: Base ¬ NIL; -- se table base address (local copy)
ctxb: Base ¬ NIL; -- context table base address (local copy)
bb: Base ¬ NIL; -- body table base address (local copy)
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];
};
}.