DIRECTORY
A3: TYPE USING [AccessMode, CanonicalType, LhsMode, LifeTime],
Alloc: TYPE USING [Notifier],
ComData: TYPE USING [typeINT, typeSTRING],
P3: TYPE USING [phraseNP, RecordLhs, SetNP],
P3S: TYPE USING [currentBody],
Symbols:
TYPE
USING [
Base, SEIndex, ISEIndex, CSEIndex, ContextLevel, CTXIndex, CBTIndex,
CSENull, CTXNull, CBTNull, lG, lZ, typeANY, bodyType, ctxType, seType],
SymbolOps: TYPE USING [UnderType, XferMode],
Tree: TYPE USING [Base, Index, Link, NullIndex, treeType],
TreeOps: TYPE USING [GetInfo, ListLength, NthSon, OpName];
Attr3b:
PROGRAM
IMPORTS
A3, P3, P3S, SymbolOps, TreeOps,
dataPtr: ComData
EXPORTS A3 = {
OPEN SymbolOps, Symbols, TreeOps, A: A3;
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)
TreeNotify:
PUBLIC Alloc.Notifier = {
called by allocator whenever table area is repacked
seb ← base[seType]; ctxb ← base[ctxType];
bb ← base[bodyType];
tb ← base[Tree.treeType]};
tree manipulation utilities
TypeForTree:
PUBLIC
PROC [t: Tree.Link]
RETURNS [SEIndex] = {
N.B. assumes t evaluated by P3.TypeLink or P3.Exp
RETURN [
WITH t
SELECT
FROM
symbol => index,
subtree =>
SELECT tb[index].name
FROM
cdot, discrimTC => TypeForTree[tb[index].son[2]],
ENDCASE => tb[index].info,
ENDCASE => typeANY]};
InterfaceVar:
PROC [t: Tree.Link]
RETURNS [
BOOL] =
INLINE {
RETURN [
WITH t
SELECT
FROM
symbol => (ctxb[seb[index].idCtx].ctxType = imported),
ENDCASE => FALSE]};
WritableRef:
PROC [t: Tree.Link]
RETURNS [
A.LhsMode] = {
P3.phraseNP ← P3.SetNP[P3.phraseNP];
RETURN [A.AccessMode[A.CanonicalType[OperandType[t]]]]};
VarLhsMode:
ARRAY
A.LhsMode
OF
A.LhsMode = [
none: $none, uncounted: $counted, counted: $counted];
OperandLhs:
PUBLIC
PROC [t: Tree.Link]
RETURNS [
A.LhsMode] = {
WITH t
SELECT
FROM
symbol => {
sei: ISEIndex = index;
ctx: CTXIndex = seb[sei].idCtx;
level: ContextLevel;
IF ctx = CTXNull THEN level ← lZ
ELSE {
ctxb[ctx].varUpdated ← TRUE;
IF (level ← ctxb[ctx].level) < P3S.currentBody.level
THEN
P3.phraseNP ← P3.SetNP[P3.phraseNP]};
P3.RecordLhs[sei];
RETURN [
SELECT
TRUE
FROM
seb[sei].immutable => $none,
(level = lG) => $counted,
ENDCASE => $uncounted]};
subtree => {
node: Tree.Index = index;
RETURN [
IF node = Tree.NullIndex
THEN $none
ELSE
SELECT tb[node].name
FROM
$dot =>
WITH tb[node].son[2]
SELECT
FROM
symbol =>
SELECT
TRUE
FROM
seb[index].immutable => $none,
(ctxb[seb[index].idCtx].level = lG) =>
VarLhsMode[WritableRef[tb[node].son[1]]],
ENDCASE => WritableRef[tb[node].son[1]],
ENDCASE => none,
$uparrow =>
IF InterfaceVar[tb[node].son[1]]
THEN VarLhsMode[WritableRef[tb[node].son[1]]]
ELSE WritableRef[tb[node].son[1]],
$dindex => WritableRef[tb[node].son[1]],
$reloc => WritableRef[tb[node].son[2]],
$dollar =>
WITH tb[node].son[2]
SELECT
FROM
symbol =>
IF ~seb[index].immutable
THEN OperandLhs[tb[node].son[1]]
ELSE $none,
ENDCASE => $none,
$index, $seqindex, $loophole, $cast, $openx, $pad, $chop =>
OperandLhs[tb[node].son[1]],
$cdot => OperandLhs[tb[node].son[2]],
$apply => IF ListLength[tb[node].son[1]] = 1 THEN $uncounted ELSE $none,
ENDCASE => $none]};
ENDCASE => RETURN [$none]};
OperandInline:
PUBLIC
PROC [t: Tree.Link]
RETURNS [
BOOL] = {
bti: CBTIndex;
RETURN [
SELECT XferMode[OperandType[t]]
FROM
$proc => (bti𡤋odyForTree[t]) # CBTNull AND bb[bti].inline,
ENDCASE => FALSE]};
OperandLevel:
PUBLIC
PROC [t: Tree.Link]
RETURNS [level:
A.LifeTime] = {
SELECT OpName[t]
FROM
$cdot, $nil => level ← $global;
ENDCASE => {
bti: CBTIndex = BodyForTree[t];
level ←
SELECT
TRUE
FROM
(bti = CBTNull) => $unknown,
(bb[bti].level <= lG+1) => $global,
ENDCASE => $local};
RETURN};
OperandInternal:
PUBLIC
PROC [t: Tree.Link]
RETURNS [
BOOL] = {
WITH t
SELECT
FROM
symbol => {
bti: CBTIndex = BodyForTree[t];
RETURN [bti # CBTNull AND bb[bti].internal]};
subtree =>
RETURN [
SELECT OpName[t]
FROM
$dot, $cdot, $assignx => OperandInternal[NthSon[t, 2]],
$ifx => OperandInternal[NthSon[t, 2]] OR OperandInternal[NthSon[t, 3]],
ENDCASE => FALSE]; -- should check casex, bindx also
ENDCASE => RETURN [FALSE]};
OperandType:
PUBLIC
PROC [t: Tree.Link]
RETURNS [CSEIndex] = {
RETURN [
WITH e:t
SELECT
FROM
symbol => UnderType[seb[e.index].idType],
literal =>
WITH e.index
SELECT
FROM
string => dataPtr.typeSTRING,
ENDCASE => dataPtr.typeINT,
subtree => tb[e.index].info,
ENDCASE => CSENull]};
LongPath:
PUBLIC
PROC [t: Tree.Link]
RETURNS [long:
BOOL] = {
WITH t
SELECT
FROM
subtree => {
node: Tree.Index = index;
long ←
IF node = Tree.NullIndex
THEN FALSE
ELSE
SELECT tb[node].name
FROM
$loophole, $cast, $openx, $pad, $chop => LongPath[tb[node].son[1]],
-- $dot, $uparrow, $dindex, $reloc, $seqindex, $dollar, $index => --
ENDCASE => tb[node].attr2};
ENDCASE => long ← FALSE;
RETURN};
BodyForTree:
PUBLIC
PROC [t: Tree.Link]
RETURNS [CBTIndex] = {
node: Tree.Index;
WITH t
SELECT
FROM
symbol => {
sei: ISEIndex = index;
SELECT
TRUE
FROM
seb[sei].mark4 =>
RETURN [IF seb[sei].constant THEN seb[sei].idInfo ELSE CBTNull];
seb[sei].immutable => {
node ← seb[sei].idValue;
IF OpName[tb[node].son[3]] = $body THEN RETURN [GetInfo[tb[node].son[3]]]};
ENDCASE};
subtree => {
node ← index;
SELECT tb[node].name
FROM
$cdot, $dot, $dollar => RETURN [BodyForTree[tb[node].son[2]]];
ENDCASE};
ENDCASE;
RETURN [CBTNull]};
}.