-- RTWalkSymbolsImpl.mesa
-- Last Modified On December 22, 1982 1:15 pm by Paul Rovner

DIRECTORY
ConvertUnsafe USING[ToRope],
Rope USING[ROPE],
RTSymbolDefs USING[SymbolTableBase, SymbolIndex, SymbolContextIndex,
SymbolIdIndex, nullSymbolIndex, symbolIndexForTYPE,
SymbolRecordIndex, nullSymbolContextIndex, nullSymbolNameIndex],
RTSymbolOps USING[], -- EXPORTS only
RTSymbols USING[Outer],
Strings USING[AppendSubString, SubStringDescriptor];

RTWalkSymbolsImpl: PROGRAM
IMPORTS ConvertUnsafe, RTSymbols, Strings
EXPORTS RTSymbolOps

= BEGIN OPEN Rope, RTSymbolDefs, RTSymbols;

--Procedures--

IsRC: PUBLIC PROC[stb: SymbolTableBase,
seIndex: SymbolIndex,
checkCommon: BOOL ← TRUE]
RETURNS[BOOL] =
{ WITH cr: stb.seb[stb.UnderType[seIndex]] SELECT FROM
record =>
{ rcP: PROC[stb: SymbolTableBase, isei: SymbolIdIndex]
RETURNS[stop: BOOL] =
{ sei: SymbolIndex ← stb.seb[isei].idType;
WITH cse1: stb.seb[stb.UnderType[sei]] SELECT FROM
union =>
{urcP: PROC[stb: SymbolTableBase, isei: SymbolIdIndex]
RETURNS[stop: BOOL] =
{ IF IsRC[stb, isei, FALSE] THEN RETURN[TRUE]; -- stop looking. This is it
RETURN[FALSE]}; -- keep looking
tagCardinality: CARDINAL ← stb.Cardinality[stb.seb[cse1.tagSei].idType];
RETURN[EnumerateCtxIseis[stb, cse1.caseCtx, urcP,
(tagCardinality = stb.CtxEntries[cse1.caseCtx])]]};
sequence => IF IsRC[stb, cse1.componentType] THEN RETURN[TRUE]; -- here 'tis
ENDCASE => IF IsRC[stb, sei] THEN RETURN[TRUE]; -- stop looking. This is it
RETURN[FALSE]}; -- keep looking

IF checkCommon
THEN RETURN[cr.hints.refField] -- easy if the common parts are to be included
ELSE RETURN[EnumerateCtxIseis[stb, cr.fieldCtx, rcP]]};-- look individually at the fields
sequence, union => ERROR;
transfer => RETURN[FALSE]; -- NOTE for now
relative => RETURN[FALSE]; -- NOTE for now
long => RETURN[WITH rse: stb.seb[stb.UnderType[cr.rangeType] ] SELECT FROM
ref => rse.counted,
ENDCASE => FALSE];
zone => RETURN[cr.counted];
array => RETURN[IsRC[stb, cr.componentType]];
ENDCASE => RETURN[FALSE]};

IsUnion: PUBLIC PROC [stb: SymbolTableBase, seIndex: SymbolIndex]
RETURNS[BOOL] =
{RETURN[stb.seb[stb.UnderType[seIndex]].typeTag = union]};

IsSequence: PUBLIC PROC [stb: SymbolTableBase, seIndex: SymbolIndex]
RETURNS[BOOL] =
{RETURN[stb.seb[stb.UnderType[seIndex]].typeTag = sequence]};

EnumerateRecordIseis: PUBLIC PROC
[ stb: SymbolTableBase,
rsei: SymbolRecordIndex,
p: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] RETURNS[stop: BOOL],
level: CARDINAL ← 0,
mesaSymbolsOK: BOOL ← FALSE]
RETURNS [stopped: BOOL] =
{ proc: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] RETURNS[stop: BOOL] =
{ sei: SymbolIndex ← stb.seb[isei].idType;
IF NOT (IsUnion[stb, sei] OR IsSequence[stb, sei]) OR level = 0
THEN RETURN[p[stb, isei]];
RETURN[FALSE]};

IF rsei = nullSymbolIndex THEN RETURN[FALSE];
WITH lrc: stb.seb[rsei] SELECT FROM
linked =>
{ stopped ← EnumerateRecordIseis[stb,
LOOPHOLE[stb.UnderType[lrc.linkType]],
p,
level + 1,
mesaSymbolsOK];
IF stopped THEN RETURN[TRUE]};
ENDCASE;
RETURN[EnumerateCtxIseis[stb, stb.seb[rsei].fieldCtx, proc, mesaSymbolsOK]]};

-- copied in RCMapBuilderImpl
EnumerateCtxIseis: PUBLIC PROC
[ stb: SymbolTableBase,
ctx: SymbolContextIndex,
proc: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] RETURNS[stop: BOOL],
reallyComplete: BOOL ← FALSE,
mesaSymbolsOK: BOOL ← FALSE]
RETURNS[stopped: BOOL] =
{ isei: SymbolIdIndex;
IF ctx = nullSymbolContextIndex THEN RETURN[FALSE];
IF NOT reallyComplete THEN
{ WITH c: stb.ctxb[ctx] SELECT FROM
included =>
IF ~c.complete THEN
{ p: PROC[base: SymbolTableBase] = -- called once
{ stopped ← EnumerateCtxIseis[base, c.map, proc]};
Outer[stb, c.module, p, mesaSymbolsOK];
RETURN[stopped];
};
simple => NULL;
ENDCASE => ERROR;
};
FOR isei ← stb.FirstCtxSe[ctx], stb.NextSe[isei] UNTIL isei = nullSymbolIndex
DO IF stb.seb[isei].hash = nullSymbolNameIndex
AND stb.seb[isei].idCtx = nullSymbolContextIndex
THEN LOOP; -- padding
IF proc[stb, isei] THEN RETURN[TRUE]; ENDLOOP;
RETURN[FALSE]};

CountComponents: PUBLIC PROC [stb: SymbolTableBase, rsei: SymbolRecordIndex]
RETURNS [n: NAT] =
{ n ← CountCommonComponents[stb, rsei];
IF stb.seb[rsei].hints.variant THEN n ← n + 1};

CountCommonComponents: PROC [stb: SymbolTableBase, rsei: SymbolRecordIndex]
RETURNS [n: CARDINAL] =
{ count: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] RETURNS[stop: BOOL] =
{ sei: SymbolIndex ← stb.seb[isei].idType;
IF NOT (IsUnion[stb, sei] OR IsSequence[stb, sei]) THEN n ← n + 1;
RETURN[FALSE]; -- keep counting
};
n ← 0;
[] ← EnumerateRecordIseis[stb, rsei, count]};

-- peel layers of id until the last one before either the underlying cons or a change of name
-- or a specification of default initialization
PeelAllButLast: PUBLIC PROC [stb: SymbolTableBase, isei: SymbolIdIndex]
RETURNS[SymbolIdIndex] =
{ FOR sei: SymbolIndex ← stb.seb[isei].idInfo, stb.seb[isei].idInfo
UNTIL stb.seb[isei].extended -- i.e. isei has default initialization specified
DO
WITH se: stb.seb[sei] SELECT FROM
id => IF se.idType # symbolIndexForTYPE THEN ERROR
ELSE IF stb.seb[isei].hash # stb.seb[LOOPHOLE[sei, SymbolIdIndex]].hash THEN EXIT
ELSE isei ← LOOPHOLE[sei, SymbolIdIndex];
cons => EXIT;
ENDCASE => ERROR;
ENDLOOP;
RETURN[isei]};

STBToModuleName: PUBLIC PROC[stb: SymbolTableBase] RETURNS[ROPE] =
{modName: STRING = [100];
STBToModName[stb, modName];
RETURN[ConvertUnsafe.ToRope[LONG[modName]]]};

STBToModName: PROC[stb: SymbolTableBase, modName: LONG STRING] =
{modName.length ← 0;
FOR isei: SymbolIdIndex ← stb.FirstCtxSe[stb.stHandle.directoryCtx], stb.NextSe[isei]
UNTIL isei = nullSymbolIndex
DO IF stb.seb[isei].public
THEN {modNameDesc: Strings.SubStringDescriptor;
stb.SubStringForHash[@modNameDesc, stb.seb[isei].hash];
Strings.AppendSubString[modName, @modNameDesc];
RETURN};
ENDLOOP};

END.