
<<ThreeC4PrimImpl3.mesa: October 18, 1985 9:52:32 am PDT>>
<<Sturgis, June 28, 1986 1:27:57 pm PDT>>
    <<Shoup, July 1, 1986 0:29:01 am PDT>>

DIRECTORY
ThreeC4Support USING[GetReportStream],
ThreeC4BaseDecl1Def USING[AppendToTypeList, BuildEmptyCode, BuildEmptyTypeList, BuildName, BuildName2, BuildRopeName, CodeFill, 
ConcatCode2, GetTheOneType, IdentifierNode, IdFill2, MesaCodeNode, NameFill, NameListNode, NameNode, RopeCode, RopeCode1, 
RopeFromRopeNode, RopeNode, TestEmptyCode, TypeListNode, TypeNode],
ThreeC4BaseDecl2Def USING[FcnDefGraphNode, FunctionCase, Use],
ThreeC4BasicAbTypesDef USING[IdListNode, WholeFileNode],
ThreeC4RootAbGramDef USING[],

ThreeC4PrimImplDefs USING[BuildType, BuildErrorTypeList, CopyTypeList, CreateHashTable, EnumerateHashTable, EqualNames, FindEntry, 
FindExistingEntry, GenNames, GenNameTypePairs, GenTypeList, GetNameIds, GetGlobalEnv, GetNameInfo, GetTypeInfo, GlobalEnvHandle,  
HashTable, IsErrorName, IsErrorTypeList, MakeEntry, PrintBadName, PrintError,  RopeFromCode, ShowCode, ShowName, ShowNameList, 
TearDownFcnDefGraphNode, UnrecoveredError],

ThreeC4FlowAnalDefs USING[ShowFcnDefGraph],

IO USING[PutF, PutRope, rope,  STREAM],
Rope USING[Cat, Equal, ROPE];


ThreeC4PrimImpl3: CEDAR PROGRAM IMPORTS ThreeC4Support, ThreeC4BaseDecl1Def, ThreeC4PrimImplDefs, ThreeC4FlowAnalDefs, IO, Rope 
EXPORTS ThreeC4BaseDecl1Def, ThreeC4BaseDecl2Def, ThreeC4BasicAbTypesDef, ThreeC4RootAbGramDef, ThreeC4PrimImplDefs = 
BEGIN OPEN ThreeC4BaseDecl1Def, ThreeC4BaseDecl2Def, ThreeC4BasicAbTypesDef, ThreeC4PrimImplDefs, ThreeC4FlowAnalDefs;


-- symbol table stuff

ContextNode: TYPE = REF ContextNodeBody;
ContextNodeBody: PUBLIC TYPE = RECORD[
types: HashTable,
abstProds: HashTable,
functions: HashTable,
values: HashTable,
grammarSymbols: HashTable, -- except genericTokens, which are in types -- 
productions: HashTable,
parseTrees: HashTable];

LockedContextNode: TYPE = REF LockedContextNodeBody;
LockedContextNodeBody: PUBLIC TYPE = RECORD[context: ContextNode];

AbstractTypeInfo: TYPE = REF AbstractTypeInfoBody;
AbstractTypeInfoBody: TYPE = RECORD[
abstractTypeId: IdentifierNode, -- named to make this record different type from others, due to unpainted record types in Cedar 
Program modules.
mesaDefFileName: Rope.ROPE,
textCodeName: Rope.ROPE,
recFcnIdList: IdListNode,
recFcnNameList: NameListNode]; 

SimpleBaseTypeInfo: TYPE = REF SimpleBaseTypeInfoBody;
SimpleBaseTypeInfoBody: TYPE = RECORD[
simpleBaseTypeId: IdentifierNode,
mesaDefFileName: Rope.ROPE,
textCodeName: Rope.ROPE];

EnumeratedBaseTypeInfo: TYPE = REF EnumeratedBaseTypeInfoBody;
EnumeratedBaseTypeInfoBody: TYPE = RECORD[
enumeratedBaseTypeId: IdentifierNode,
mesaDefFileName: Rope.ROPE,
names: NameListNode,
textCodeName: Rope.ROPE];

AbstractProductionInfo: TYPE = REF AbstractProductionInfoBody;
AbstractProductionInfoBody: TYPE = RECORD[
abstractTypeId: IdentifierNode,
caseId: IdentifierNode, -- might be NIL
mesaDefFileName: Rope.ROPE,
rightSideNames: NameListNode,
productionContext: LockedContextNode];

AbstractRightSideSymbolInfo: TYPE = REF AbstractRightSideSymbolInfoBody;
AbstractRightSideSymbolInfoBody: TYPE = RECORD[
typeName: NameNode];

GenericTokenTypeInfo: TYPE = REF GenericTokenTypeInfoBody;
GenericTokenTypeInfoBody: TYPE = RECORD[
genericTokenTypeId: IdentifierNode,
mesaDefFileName: Rope.ROPE,
textCodeName: Rope.ROPE];

PreDefinedCedarTypeInfo: TYPE = REF PreDefinedCedarTypeInfoBody;
PreDefinedCedarTypeInfoBody: TYPE = RECORD[
preDefinedCedarTypeId: IdentifierNode,
textCodeName: Rope.ROPE];

CedarTypeInfo: TYPE = REF CedarTypeInfoBody;
CedarTypeInfoBody: TYPE = RECORD[
cedarTypeId: IdentifierNode,
mesaDefFileName: Rope.ROPE,
textCodeName: Rope.ROPE];

<<there will be one of the following with name "Tree$">>
TreeTypeInfo: TYPE = REF TreeTypeInfoBody;
TreeTypeInfoBody: TYPE = RECORD[
treeTypeId: IdentifierNode, -- always nil
textCodeName: Rope.ROPE]; 

RecFcnInfo: TYPE = REF RecFcnInfoBody;
RecFcnInfoBody: TYPE = RECORD[
recFcnId: IdentifierNode, -- always nil, to make unique record type
mesaDefFileName: Rope.ROPE,
argTypes: TypeListNode,
resultTypes: TypeListNode,
defGraph: FcnDefGraphNode];

BaseFcnInfo: TYPE = REF BaseFcnInfoBody;
BaseFcnInfoBody: TYPE = RECORD[
baseFcnId: IdentifierNode, -- always nil, to make unique record type
mesaDefFileName: Rope.ROPE,
argTypes: TypeListNode,
resultTypes: TypeListNode,
defGraph: FcnDefGraphNode];

CedarFcnInfo: TYPE = REF CedarFcnInfoBody;
CedarFcnInfoBody: TYPE = RECORD[
cedarFcnId: IdentifierNode, -- always nil, to make unique record type
mesaDefFileName: Rope.ROPE,
argTypes: TypeListNode,
resultTypes: TypeListNode,
defGraph: FcnDefGraphNode];

RopeTokenInfo: TYPE = REF RopeTokenInfoBody;
RopeTokenInfoBody: TYPE = RECORD[
ropeTknId: IdentifierNode, -- always nil, to make unique record type
name: NameNode];

NonTerminalTokenInfo: TYPE = REF NonTerminalTokenInfoBody;
NonTerminalTokenInfoBody: TYPE = RECORD[
nonTerminalTokenId: IdentifierNode, -- always nil, to make unique record type
name: NameNode,
builds: TypeNode];

ProductionInfo: TYPE = REF ProductionInfoBody;
ProductionInfoBody: TYPE = RECORD[
productionInfoId: IdentifierNode, -- always nil, to make unique record type
name: NameNode,
index: INT];

ControlModuleInfo: TYPE = REF ControlModuleInfoBody;
ControlModuleInfoBody: TYPE = RECORD[
controlModuleInfoId: IdentifierNode, -- always nil, to make unique record type
mesaDefFileName: Rope.ROPE];

ParseTreeInfo: TYPE = REF ParseTreeInfoBody;
ParseTreeInfoBody: TYPE = RECORD[
parseTreeInfoId: IdentifierNode, -- always nil, to make unique record type
tree: WholeFileNode];
 
ErrorInfo: TYPE = REF ErrorInfoBody;
ErrorInfoBody: TYPE = RECORD [
errorInfoBody: IdentifierNode -- always nil, to make unique record type
];


BuildErrorInfo: PUBLIC PROC RETURNS [REF ANY] =
BEGIN
RETURN [NEW[ErrorInfoBody _ [NIL]]];
END;

BuildErrorType: PUBLIC PROC RETURNS [TypeNode] =
BEGIN
RETURN [BuildType[BuildErrorInfo[]]];
END;

IsErrorType: PUBLIC PROC [type: TypeNode] RETURNS [BOOLEAN] =
BEGIN
RETURN [ISTYPE[GetTypeInfo[type], ErrorInfo]];
END;


<<Note: a Mesa definition file name can be built from a base by Concat[baseName, "Def.mesa"]>>
<<>>
<<>>
BuildEmptyContext: PUBLIC PROC RETURNS[ContextNode] =
BEGIN
RETURN[NEW[ContextNodeBody_[
CreateHashTable[10],
CreateHashTable[10],
CreateHashTable[10],
CreateHashTable[10],
CreateHashTable[10],
CreateHashTable[10],
CreateHashTable[10]]]];
END;

FakeCopyContextForConditional: PUBLIC PROC[arg: ContextNode] RETURNS[ContextNode] =
{RETURN[arg]};

LockContext: PUBLIC PROC[arg: ContextNode] RETURNS[LockedContextNode] =
{RETURN[NEW[LockedContextNodeBody_[arg]]]};

RecordAbstractType: PUBLIC PROC[context: ContextNode, type: NameNode, mesaDefFileName: Rope.ROPE, codeName: MesaCodeNode, 
recFcnIdList: IdListNode, recFcnNameList: NameListNode] RETURNS[ContextNode] =
BEGIN
id1, id2: IdentifierNode;

IF IsErrorName[type] THEN RETURN [context];

[id1, id2] _ GetNameIds[type];
IF id2 # NIL THEN 
BEGIN
PrintBadName[type, "modified name not allowed in this context.\N"];
RETURN [context];
END;
MakeEntry[context.types, type, NEW[AbstractTypeInfoBody_[id1, mesaDefFileName, RopeFromCode[codeName], recFcnIdList, 
recFcnNameList]]];
RETURN[context];
END;

RecordSimpleBaseType: PUBLIC PROC[context: ContextNode, type: NameNode, mesaDefFileName: Rope.ROPE, codeName: MesaCodeNode] 
RETURNS[ContextNode] =
BEGIN
id1, id2: IdentifierNode;

IF IsErrorName[type] THEN RETURN [context];

[id1, id2] _ GetNameIds[type];
IF id2 # NIL THEN
BEGIN
PrintBadName[type, "modified name not allowed in this context.\N"];
RETURN [context];
END;

MakeEntry[context.types, type, NEW[SimpleBaseTypeInfoBody_[id1, mesaDefFileName, RopeFromCode[codeName]]]];
RETURN[context];
END;

<<damages context argument, result shares with names argument>>
RecordEnumeratedBaseType: PUBLIC PROC[context: ContextNode, type: NameNode, mesaDefFileName: Rope.ROPE, names: NameListNode, 
codeName: MesaCodeNode] RETURNS[ContextNode] =
BEGIN
id1, id2: IdentifierNode;

IF IsErrorName[type] THEN RETURN [context];

[id1, id2] _ GetNameIds[type];


IF id2 # NIL THEN 
BEGIN
PrintBadName[type, "modified name not allowed in this context.\N"];
RETURN [context];
END;
MakeEntry[context.types, type, NEW[EnumeratedBaseTypeInfoBody_[id1, mesaDefFileName, names, RopeFromCode[codeName]]]];
RETURN[context];
END;

<<damages context argument.>>
<<result shares with name list argument>>
RecordAbstractProduction: PUBLIC PROC[context: ContextNode, productionName: NameNode, mesaDefFileName: Rope.ROPE, rightSideNames: 
NameListNode, productionContext: LockedContextNode] RETURNS[ContextNode] =
BEGIN
id1, id2: IdentifierNode;

IF IsErrorName[productionName] THEN RETURN [context];

[id1, id2] _ GetNameIds[productionName];
MakeEntry[context.abstProds, productionName, NEW[AbstractProductionInfoBody_[id1, id2, mesaDefFileName, rightSideNames, 
productionContext]]];
RETURN[context];
END;

<<damages context argument>>
RecordAbstRightSideSymbol: PUBLIC PROC[context: ContextNode, name: NameNode, typeName: NameNode] RETURNS[ContextNode] =
BEGIN
IF IsErrorName[name] OR IsErrorName[typeName] THEN RETURN [context];

MakeEntry[context.values, name, NEW[AbstractRightSideSymbolInfoBody_[typeName]]];
RETURN[context];
END;

<<damages context argument>>
RecordGenericToken: PUBLIC PROC[context: ContextNode, type: NameNode, mesaDefFileName: Rope.ROPE, codeName: MesaCodeNode] 
RETURNS[ContextNode] =
BEGIN
id1, id2: IdentifierNode;

IF IsErrorName[type] THEN RETURN [context];

[id1, id2] _ GetNameIds[type];
IF id2 # NIL THEN 
BEGIN
PrintBadName[type, "modified name not allowed in this context.\N"];
RETURN [context];
END;
MakeEntry[context.types, type, NEW[GenericTokenTypeInfoBody_[id1, mesaDefFileName, RopeFromCode[codeName]]]];
RETURN[context];
END;

<<damages context argument>>
RecordGenericTokenFrom: PUBLIC PROC[context: ContextNode, type: NameNode, mesaDefFileName: Rope.ROPE, codeName: MesaCodeNode] 
RETURNS[ContextNode] =
BEGIN
id1, id2: IdentifierNode;

IF IsErrorName[type] THEN RETURN [context];

[id1, id2] _ GetNameIds[type];
IF id2 # NIL THEN 
BEGIN
PrintBadName[type, "modified name not allowed in this context.\N"];
RETURN [context];
END;
MakeEntry[context.types, type, NEW[GenericTokenTypeInfoBody_[id1, mesaDefFileName, RopeFromCode[codeName]]]];
RETURN[context];
END;

<<damages context argument>>
RecordPreDefinedCedarType: PUBLIC PROC[context: ContextNode, type: NameNode, codeName: MesaCodeNode] RETURNS[ContextNode] =
BEGIN
id1, id2: IdentifierNode;

IF IsErrorName[type] THEN RETURN [context];

[id1, id2] _ GetNameIds[type];
IF id2 # NIL THEN 
BEGIN
PrintBadName[type, "modified name not allowed in this context.\N"];
RETURN [context];
END;

MakeEntry[context.types, type, NEW[PreDefinedCedarTypeInfoBody_[id1, RopeFromCode[codeName]]]];
RETURN[context];
END;

<<damages context argument>>
RecordCedarType: PUBLIC PROC[context: ContextNode, type: NameNode, mesaDefFileName: Rope.ROPE, codeName: MesaCodeNode] 
RETURNS[ContextNode] =
BEGIN
id1, id2: IdentifierNode;

IF IsErrorName[type] THEN RETURN [context];

[id1, id2] _ GetNameIds[type];
IF id2 # NIL THEN 
BEGIN
PrintBadName[type, "modified name not allowed in this context.\N"];
RETURN [context];
END;
MakeEntry[context.types, type, NEW[CedarTypeInfoBody_[id1, mesaDefFileName, RopeFromCode[codeName]]]];
RETURN[context];
END;

<<damages context argument>>
<<result shares with the two list arguments>>
RecordCedarFunction: PUBLIC PROC[context: ContextNode, name: NameNode, mesaDefFileName: Rope.ROPE, argTypes: TypeListNode, 
resultTypes: TypeListNode] RETURNS[ContextNode] =
BEGIN
IF IsErrorName[name] OR IsErrorTypeList[argTypes] OR IsErrorTypeList[resultTypes] THEN
RETURN [context];

MakeEntry[context.functions, name, NEW[CedarFcnInfoBody_[NIL, mesaDefFileName, argTypes, resultTypes]]];
RETURN[context];
END;

<<damages context argument>>
<<result shares with the two list arguments>>
RecordBaseFunction: PUBLIC PROC[context: ContextNode, name: NameNode, mesaDefFileName: Rope.ROPE, argTypes: TypeListNode, 
resultTypes: TypeListNode, defGraph: FcnDefGraphNode] RETURNS[ContextNode] =
BEGIN
IF IsErrorName[name] OR IsErrorTypeList[argTypes] OR IsErrorTypeList[resultTypes] THEN
RETURN [context];

MakeEntry[context.functions, name, NEW[BaseFcnInfoBody_[NIL, mesaDefFileName, argTypes, resultTypes, defGraph]]];
RETURN[context];
END;


<<damages context argument>>
<<result shares with the two list arguments>>
RecordRecFcnDef: PUBLIC PROC[context: ContextNode, name: NameNode, mesaDefFileName: Rope.ROPE, argTypes: TypeListNode, resultTypes: 
TypeListNode, defGraph: FcnDefGraphNode] RETURNS[ContextNode] =
BEGIN
IF IsErrorName[name] OR IsErrorTypeList[argTypes] OR IsErrorTypeList[resultTypes] THEN
RETURN [context];

MakeEntry[context.functions, name, NEW[RecFcnInfoBody_[NIL, mesaDefFileName, argTypes, resultTypes, defGraph]]];
RETURN[context]
END;

<<damages context argument>>
<<result shares with the two list arguments>>
RecordBaseFcnDef: PUBLIC PROC[context: ContextNode, name: NameNode, mesaDefFileName: Rope.ROPE, argTypes: TypeListNode, 
resultTypes: TypeListNode, defGraph: FcnDefGraphNode] RETURNS[ContextNode] =
BEGIN
IF IsErrorName[name] OR IsErrorTypeList[argTypes] OR IsErrorTypeList[resultTypes] THEN
RETURN [context];

MakeEntry[context.functions, name, NEW[BaseFcnInfoBody_[NIL, mesaDefFileName, argTypes, resultTypes, defGraph]]];
RETURN[context]
END;
<<>>
<<damages context argument>>
RecordGlobalTreeType: PUBLIC PROC[context: ContextNode, name: NameNode, codeName: MesaCodeNode] RETURNS[ContextNode] =
BEGIN
IF IsErrorName[name] THEN RETURN[context];

MakeEntry[context.types, name, NEW[TreeTypeInfoBody_[NIL, RopeFromCode[codeName]]]];
RETURN[context];
END;

<<damages context argument>>
RecordRopeToken: PUBLIC PROC[context: ContextNode, rope: RopeNode] RETURNS[ContextNode] =
BEGIN
name: NameNode _ BuildRopeName[RopeFromRopeNode[rope]];
MakeEntry[context.grammarSymbols, name, NEW[RopeTokenInfoBody_[NIL, name]]];
RETURN[context];
END;


<<damages context argument>>
RecordNonTerminalToken: PUBLIC PROC[context: ContextNode, name: NameNode, builds: NameNode] RETURNS[ContextNode] =
BEGIN
type: TypeNode;

IF IsErrorName[name] OR IsErrorName[builds] THEN RETURN [context];

type _ FindType[context, builds];
IF GetNameIds[name].id2 # NIL THEN 
BEGIN
PrintBadName[name, "modified name not allowed in this context"];
RETURN [context];
END;
MakeEntry[context.grammarSymbols, name, NEW[NonTerminalTokenInfoBody_[NIL, name, type]]];
RETURN[context];
END;

<<damages context argument>>
RecordProduction: PUBLIC PROC[context: ContextNode, name: NameNode, index: INT] RETURNS[ContextNode] =
BEGIN
IF IsErrorName[name] THEN RETURN [context];

MakeEntry[context.productions, name, NEW[ProductionInfoBody_[NIL, name, index]]];
RETURN[context];
END;

<<damages context argument>>
RecordControlModule: PUBLIC PROC[context: ContextNode, mesaDefFileName: Rope.ROPE] RETURNS[ContextNode] =
BEGIN
MakeEntry[context.types, BuildRopeName["$Control"], NEW[ControlModuleInfoBody_[NIL, mesaDefFileName]]];
RETURN[context];
END;


<<damages context argument>>
RecordAbstractTypeFrom: PUBLIC PROC[context: ContextNode, type: NameNode, mesaDefFileName: Rope.ROPE, codeName: MesaCodeNode] 
RETURNS[ContextNode] =
BEGIN
id1, id2: IdentifierNode;

IF IsErrorName[type] THEN RETURN [context];

[id1, id2] _ GetNameIds[type];
IF id2 # NIL THEN 
BEGIN
PrintBadName[type, "modified name not allowed in this context"];
RETURN [context];
END;
MakeEntry[context.types, type, NEW[AbstractTypeInfoBody_[id1, mesaDefFileName, RopeFromCode[codeName], NIL, NIL]]];
RETURN[context];
END;

RecordParseTree: PUBLIC PROC[context: ContextNode, name: NameNode, tree: WholeFileNode] RETURNS[ContextNode] =
BEGIN
IF IsErrorName[name] THEN RETURN [context];

MakeEntry[context.parseTrees, name, NEW[ParseTreeInfoBody_[NIL, tree]]];
RETURN[context]
END;

FindParseTree: PUBLIC PROC[context: ContextNode, name: NameNode] RETURNS[WholeFileNode] =
BEGIN
info: REF ANY;

IF IsErrorName[name] THEN RETURN[NIL];

info _ FindEntry[context.parseTrees, name];
IF info = NIL THEN RETURN [NIL];
WITH info SELECT FROM
pti: ParseTreeInfo => RETURN [pti.tree];
ei: ErrorInfo => RETURN [NIL];
ENDCASE => ERROR;
END;

<<used for other varieties of parse trees (e.g. tran4)>>
RecordOtherParseTree: PUBLIC PROC[context: ContextNode, name: NameNode, info: REF ANY] RETURNS[ContextNode] =
BEGIN
IF IsErrorName[name] THEN RETURN [context];

MakeEntry[context.parseTrees, name, info];
RETURN[context]
END;
<<>>
<<used for other varieties of parse trees (e.g. tran4)>>
FindOtherParseTree: PUBLIC PROC[context: ContextNode, name: NameNode] RETURNS[REF ANY] =
BEGIN
info: REF ANY;

IF IsErrorName[name] THEN RETURN [BuildErrorInfo[]];

info _ FindEntry[context.parseTrees, name];
IF info = NIL THEN 
BEGIN
PrintBadName[name, "undefined or out of context -- expected ParseTree"];
RETURN [BuildErrorInfo[]];
END;
RETURN[info]
END;


<<used, for example, by tran4>>
<<exported to Tran4BridgeDef>>
RecordOtherType: PUBLIC PROC[context: ContextNode, name: NameNode, info: REF ANY] RETURNS[ContextNode] =
BEGIN

IF IsErrorName[name] THEN RETURN[context];

MakeEntry[context.types, name, info];
RETURN[context]
END;

FindType: PUBLIC PROC[context: ContextNode, name: NameNode] RETURNS[TypeNode] =
BEGIN
info: REF ANY;

IF IsErrorName[name] THEN RETURN[BuildErrorType[]];

info _ FindEntry[context.types, name];
IF info = NIL THEN
BEGIN
PrintBadName[name, "undefined or out of context -- expected BaseType, AbstractType, or GenericToken"];
RETURN [BuildErrorType[]];
END;
RETURN[BuildType[info]];
END;

GetTypeCodeName: PUBLIC PROC[type: TypeNode] RETURNS[MesaCodeNode] =
BEGIN
WITH GetTypeInfo[type] SELECT FROM
ati: AbstractTypeInfo => RETURN[RopeCode[ati.textCodeName]];
sbti: SimpleBaseTypeInfo => RETURN[RopeCode[sbti.textCodeName]];
gtti: GenericTokenTypeInfo => RETURN[RopeCode[gtti.textCodeName]];
pdcti: PreDefinedCedarTypeInfo => RETURN[RopeCode[pdcti.textCodeName]];
cti: CedarTypeInfo => RETURN[RopeCode[cti.textCodeName]];
tti: TreeTypeInfo => RETURN[RopeCode[tti.textCodeName]];
ebti: EnumeratedBaseTypeInfo => RETURN[RopeCode[ebti.textCodeName]];
ei: ErrorInfo => RETURN [RopeCode["** ERROR **"]];
ENDCASE => ERROR;
END;

CompareValTypeWithVarType: PUBLIC PROC[val: TypeNode, var: TypeNode] RETURNS[BOOLEAN] =
BEGIN
IF val = var THEN RETURN[TRUE];
IF GetTypeInfo[val] = GetTypeInfo[var] THEN RETURN[TRUE];
IF ISTYPE[GetTypeInfo[var], TreeTypeInfo] AND ISTYPE[GetTypeInfo[val], AbstractTypeInfo] THEN RETURN [TRUE];
IF ISTYPE[GetTypeInfo[var], ErrorInfo] OR ISTYPE[GetTypeInfo[val], ErrorInfo] THEN
RETURN [TRUE];
PrintError["type mismatch -- expected a value of type ", GetTypeRope[var], " but found a value of type ", GetTypeRope[val]];
RETURN [FALSE];
END;

EqualTypes: PUBLIC PROC[t1, t2: TypeNode] RETURNS[BOOLEAN] =
BEGIN
IF t1 = t2 THEN RETURN[TRUE];
IF GetTypeInfo[t1] = GetTypeInfo[t2] THEN RETURN[TRUE];
IF ISTYPE[GetTypeInfo[t1], ErrorInfo] THEN RETURN [TRUE];
IF ISTYPE[GetTypeInfo[t2], ErrorInfo] THEN RETURN [TRUE];
RETURN[FALSE];
END;


GetTypeRope:  PROC[type: TypeNode] RETURNS [Rope.ROPE] =
BEGIN
RETURN [GetTypeInfoRope[GetTypeInfo[type]]];
END;

    GetTypeInfoRope:  PROC[info: REF ANY] RETURNS [Rope.ROPE] =
    BEGIN
    WITH info SELECT FROM
    ati: AbstractTypeInfo => RETURN [Rope.Cat["AbstractType(", ati.abstractTypeId.text, ")"]];
    sbti: SimpleBaseTypeInfo => RETURN [Rope.Cat["BaseType(", sbti.simpleBaseTypeId.text, ")"]];
    gtti: GenericTokenTypeInfo => RETURN [Rope.Cat["GenericToken(", gtti.genericTokenTypeId.text, ")"]]; 
    pdcti: PreDefinedCedarTypeInfo => RETURN [Rope.Cat["CedarType(", pdcti.preDefinedCedarTypeId.text, ")"]];
    cti: CedarTypeInfo => RETURN [Rope.Cat["CedarType(", cti.cedarTypeId.text, ")"]];
    tti: TreeTypeInfo => RETURN ["AbstractType"];
    ebti: EnumeratedBaseTypeInfo => RETURN [Rope.Cat["BaseType(", ebti.enumeratedBaseTypeId.text, ")"]]; 
    api: AbstractProductionInfo => RETURN["AbstractProduction"];
    arssi: AbstractRightSideSymbolInfo => RETURN["AbstractRightSideSymbol"];
    rfi: RecFcnInfo => RETURN ["TreeRecursiveFunction"];
    bfi: BaseFcnInfo => RETURN ["BaseFunction"];
    cfi: CedarFcnInfo => RETURN["CedarFunction"];
    rti: RopeTokenInfo => RETURN["RopeToken"];
    ntti: NonTerminalTokenInfo  => RETURN ["NonTerminal"];
    pi: ProductionInfo => RETURN ["Production"];
    cmi: ControlModuleInfo => RETURN ["ControlModule"];
    pti: ParseTreeInfo => RETURN["ParseTree"];
    ei: ErrorInfo => RETURN["** Error **"];

    ENDCASE => RETURN ["???"];
    END;


    ShortShowType: PUBLIC PROC[type: TypeNode, on: IO.STREAM] =
    BEGIN
    WITH GetTypeInfo[type] SELECT FROM
    ati: AbstractTypeInfo => ShowId[ati.abstractTypeId, on];
    sbti: SimpleBaseTypeInfo => ShowId[sbti.simpleBaseTypeId, on];
    gtti: GenericTokenTypeInfo => ShowId[gtti.genericTokenTypeId, on]; 
    pdcti: PreDefinedCedarTypeInfo => ShowId[pdcti.preDefinedCedarTypeId, on];
    cti: CedarTypeInfo => ShowId[cti.cedarTypeId, on];
    tti: TreeTypeInfo => IO.PutF[on, "Tree$"];
    ebti: EnumeratedBaseTypeInfo => ShowId[ebti.enumeratedBaseTypeId, on]; 
    ENDCASE => ERROR;
    END;

ShowTypeList: PUBLIC PROC[typeList: TypeListNode, on: IO.STREAM] =
BEGIN
oneShown: BOOLEAN _ FALSE;
seeOneType: PROC[type: TypeNode] =
BEGIN
IF oneShown THEN IO.PutRope[on, ", "] ELSE oneShown _ TRUE;
ShortShowType[type, on];
END;

GenTypeList[typeList, seeOneType];
END;


CheckForBOOLEANType: PUBLIC PROC[type: TypeNode] RETURNS[BOOLEAN] =
BEGIN
WITH GetTypeInfo[type] SELECT FROM
pdcti: PreDefinedCedarTypeInfo => IF Rope.Equal["BOOLEAN", pdcti.textCodeName] THEN RETURN[TRUE];
ei: ErrorInfo => RETURN [TRUE];
ENDCASE => NULL;

PrintError["type mismatch -- expected a value of type CedarType(BOOLEAN) but found a value of type ", GetTypeRope[type]];
RETURN [TRUE];
END;

CheckForOneBoolean: PUBLIC PROC[list: TypeListNode] RETURNS[BOOLEAN] =
BEGIN
RETURN[CheckForBOOLEANType[GetTheOneType[list]]];
END;

<<Lookup contexts>>

LookupContextNode: TYPE = REF LookupContextNodeBody;
LookupContextNodeBody: PUBLIC TYPE = RECORD[
global: ContextNode,
production: LockedContextNode,
vars: VarItem,
rightSideSymbols: RSSItem];

VarItem: TYPE = REF VarItemBody;
VarItemBody: TYPE = RECORD[
name: NameNode,
type: TypeNode,
next: VarItem];

RSSItem: TYPE = REF RSSItemBody;
RSSItemBody: TYPE = RECORD[
name: NameNode,
type: TypeNode,
next: RSSItem]; 

<<argument is shared with result>>
BuildBasicLookupContext: PUBLIC PROC[context: ContextNode] RETURNS[LookupContextNode] =
{RETURN[NEW[LookupContextNodeBody_[context, NIL, NIL, NIL]]]};

FakeCopyLookupContext: PUBLIC PROC[lookup: LookupContextNode] RETURNS[LookupContextNode] = 
{RETURN[lookup]};

<<both arguments are shared with result>>
PushProductionContext: PUBLIC PROC[lookup: LookupContextNode, production: LockedContextNode] RETURNS[LookupContextNode] =
BEGIN
IF lookup.production # NIL THEN ERROR;
RETURN[NEW[LookupContextNodeBody_[lookup.global, production, NIL]]];
END;

<<neither shares nor affects any argument>>
RecordVarSeq: PUBLIC PROC[lookup: LookupContextNode, names: NameListNode, types: TypeListNode] RETURNS[LookupContextNode] =
BEGIN
newContext: LookupContextNode _ NEW[LookupContextNodeBody_[lookup.global, lookup.production, lookup.vars]];

SeePair: PROC[name: NameNode, type: TypeNode] =
BEGIN
newItem: VarItem;
IF IsErrorName[name] THEN RETURN;

newItem _ NEW[VarItemBody_[name, type, newContext.vars]];
newContext.vars _ newItem;
END;

GenNameTypePairs[names, types, SeePair];
RETURN[newContext];
END;

TearDownGraphs: PUBLIC PROC [lookup: LookupContextNode] RETURNS [BOOLEAN] =
BEGIN
SeeOneEntry: PROC [info: REF ANY, name: NameNode] =
BEGIN

TearDown: PROC [defGraph: FcnDefGraphNode] RETURNS [FcnDefGraphNode] =
BEGIN
-- s: IO.STREAM;

-- s _ SIGNAL ThreeC4Support.GetReportStream;
-- IO.PutF[s, "tearing down "];
-- ShowName[name, s];
-- IO.PutF[s, "\N"];

RETURN[TearDownFcnDefGraphNode[defGraph]];
END;


WITH info SELECT FROM
rfi: RecFcnInfo => rfi.defGraph _ TearDown[rfi.defGraph];
cfi: CedarFcnInfo => cfi.defGraph _ TearDown[cfi.defGraph];
bfi: BaseFcnInfo => bfi.defGraph _ TearDown[bfi.defGraph];
ENDCASE => ERROR;
END;

EnumerateHashTable[lookup.global.functions, SeeOneEntry];
RETURN [TRUE];
END;


LookUpAbTypeRecFcnsIdList: PUBLIC PROC[lookup: LookupContextNode, typeName: NameNode] RETURNS[IdListNode] =

BEGIN
info: REF ANY;

IF IsErrorName[typeName] THEN ERROR UnrecoveredError;

info  _ FindEntry[lookup.global.types, typeName];
IF info = NIL THEN
BEGIN
PrintBadName[typeName, "undefined or out of context -- expected AbstractType"];
ERROR UnrecoveredError;
END;
WITH info SELECT FROM
ati: AbstractTypeInfo => RETURN [ati.recFcnIdList];
ENDCASE => {PrintBadName[typeName, "type mismatch -- expected AbstractType but found ", GetTypeInfoRope[info]]; ERROR 
UnrecoveredError};
END;


<<1st arg shared with both results>>
LookUpAbProduction: PUBLIC PROC[lookup: LookupContextNode, prodName: NameNode] RETURNS[NameListNode, LockedContextNode] =
BEGIN
info: REF ANY;

IF IsErrorName[prodName] THEN ERROR UnrecoveredError;

info _ FindEntry[lookup.global.abstProds, prodName];
IF info = NIL THEN
BEGIN
PrintBadName[prodName, "undefined or out of context -- expected AbstractProduction"];
ERROR UnrecoveredError;
END;
WITH info SELECT FROM
api: AbstractProductionInfo => RETURN [api.rightSideNames, api.productionContext];
ENDCASE => ERROR;
END;

<<1st arg shared with first result>>
LookUpRecFcnDef: PUBLIC PROC[lookup: LookupContextNode, funName: NameNode] RETURNS[TypeListNode, TypeListNode] =
BEGIN
info: REF ANY;

IF IsErrorName[funName] THEN RETURN [BuildErrorTypeList[], BuildErrorTypeList[]];

info _ FindEntry[lookup.global.functions, funName];
IF info = NIL THEN
BEGIN
PrintBadName[funName, "undefined or out of context -- expected TreeRecursiveFunction"];
RETURN [BuildErrorTypeList[], BuildErrorTypeList[]];
END;
WITH info SELECT FROM
rfi: RecFcnInfo => RETURN [rfi.argTypes, CopyTypeList[rfi.resultTypes]];
ENDCASE => {PrintBadName[funName, "type mismatch -- expected TreeRecursiveFunction but found ", GetTypeInfoRope[info]]; RETURN 
[BuildErrorTypeList[], BuildErrorTypeList[]]};

END;

<<1st arg shared with result>>
LookUpFcnDefGraph: PUBLIC PROC[lookup: LookupContextNode, funName: NameNode] RETURNS[FcnDefGraphNode] =
BEGIN
info: REF ANY;

IF IsErrorName[funName] THEN ERROR UnrecoveredError;

info _ FindEntry[lookup.global.functions, funName];
IF info = NIL THEN
BEGIN
PrintBadName[funName, "undefined or out of context -- expected TreeRecursiveFunction or BaseFunction"];
ERROR UnrecoveredError;
END;
WITH info SELECT FROM
rfi: RecFcnInfo => RETURN[rfi.defGraph];
bfi: BaseFcnInfo => RETURN[bfi.defGraph];
ENDCASE => {PrintBadName[funName, "type mismatch -- expected TreeRecursiveFunction or BaseFunction but found ", 
GetTypeInfoRope[info]]; ERROR UnrecoveredError};
END;

LookUpType: PUBLIC PROC[lookup: LookupContextNode, typeName: NameNode] RETURNS[TypeNode] =
BEGIN
info: REF ANY;

IF IsErrorName[typeName] THEN RETURN[BuildErrorType[]];

info _ FindEntry[lookup.global.types, typeName];
IF info = NIL THEN
BEGIN
PrintBadName[typeName, "undefined or out of context -- expected BaseType, AbstractType, or GenericToken"];
RETURN [BuildErrorType[]];
END;
RETURN[BuildType[info]];
END;

<<used, for example, by tran4>>
<<exported to Tran4BridgeDef>>
LookUpOtherType: PUBLIC PROC[lookup: LookupContextNode, typeName: NameNode] RETURNS[REF ANY] =
BEGIN
info: REF ANY;

IF IsErrorName[typeName] THEN RETURN[BuildErrorInfo[]];

info _ FindEntry[lookup.global.types, typeName];
IF info = NIL THEN
BEGIN
PrintBadName[typeName, "undefined or out of context -- expected BaseType, AbstractType, or GenericToken"];
RETURN [BuildErrorInfo[]];
END;
RETURN[info];
END;

LookUpSimpleValue: PUBLIC PROC[lookup: LookupContextNode, id: IdentifierNode] RETURNS[TypeNode, MesaCodeNode] =
BEGIN
name: NameNode _ BuildName[id];


-- see if its a local variable

FOR varItem: VarItem _ lookup.vars, varItem.next WHILE varItem # NIL DO
IF EqualNames[varItem.name, name]
THEN RETURN[varItem.type, RopeCode1["%g", NameFill[name]]];
ENDLOOP;

-- see if we find it in production context


BEGIN
info1: REF ANY _ FindEntry[lookup.production.values, name];
info: AbstractRightSideSymbolInfo;
type: TypeNode;


IF info1 # NIL AND NOT ISTYPE[info1, AbstractRightSideSymbolInfo] THEN 
ERROR;

info _ NARROW[info1];
type _ IF info # NIL THEN LookUpType[lookup, info.typeName] ELSE NIL;
IF type # NIL THEN RETURN[type, RopeCode1["treeData.%g", NameFill[name]]];
END;

-- so, we can't find it

PrintBadName[name, "undefined or out of context -- expected a value"];
RETURN [BuildErrorType[], RopeCode["** ERROR **"]];

END;

LookUpValue2: PUBLIC PROC[lookup: LookupContextNode, id1, id2: IdentifierNode] RETURNS[TypeNode, MesaCodeNode] =
BEGIN

-- see if we find it in production context

BEGIN
nameA: NameNode _ BuildName2[id1, id2];
info1: REF ANY _ FindEntry[lookup.production.values, nameA];
info: AbstractRightSideSymbolInfo;
type: TypeNode;

IF info1 # NIL AND NOT ISTYPE[info1, AbstractRightSideSymbolInfo] THEN
ERROR;
info _ NARROW[info1];
type _ IF info # NIL THEN LookUpType[lookup, info.typeName] ELSE NIL;
IF type # NIL THEN RETURN[type, RopeCode1["treeData.%g", IdFill2[id1, id2]]];
END;

-- see if it is an enumerated type value

BEGIN
type: TypeNode; code: MesaCodeNode;
[type, code] _ LookUpEnumTypeVal1[lookup, BuildName[id1], BuildName[id2]];
IF type # NIL THEN RETURN[type, code];
END;

-- so, we can't find it


PrintBadName[BuildName2[id1, id2], "undefined or out of context -- expected a value"];
RETURN [BuildErrorType[], RopeCode["** ERROR **"]];

END;

-- LookUpEnumTypeVal1 is just like LookUpEnumTypeVal, except that the former will return NIL values when anything goes wrong.

LookUpEnumTypeVal1:  PROC[lookup: LookupContextNode, nameB1: NameNode, nameB2: NameNode] RETURNS[TypeNode, MesaCodeNode] =
BEGIN
type: TypeNode;
info : REF ANY;

IF IsErrorName[nameB1] OR IsErrorName[nameB2] THEN
RETURN [BuildErrorType[], RopeCode["** ERROR **"]];

info _ FindEntry[lookup.global.types, nameB1];
IF info = NIL THEN RETURN [NIL, BuildEmptyCode[]];
type _ BuildType[info];


WITH info SELECT FROM
ebti: EnumeratedBaseTypeInfo =>
BEGIN
-- check for legal value name
legal: BOOLEAN _ FALSE;
seeName: PROC[nm: NameNode] =
{IF EqualNames[nm, nameB2] THEN legal _ TRUE};

GenNames[ebti.names, seeName];
IF legal THEN RETURN[type, ConcatCode2[RopeCode[ebti.textCodeName], RopeCode1[".%g", NameFill[nameB2]]]];
END;
ENDCASE => NULL;

RETURN[NIL, BuildEmptyCode[]];
END;

LookUpEnumTypeVal: PUBLIC PROC[lookup: LookupContextNode, nameB1: NameNode, nameB2: NameNode] RETURNS[TypeNode, MesaCodeNode] =
BEGIN
type: TypeNode;
code: MesaCodeNode;

IF IsErrorName[nameB1] OR IsErrorName[nameB2] THEN
RETURN [BuildErrorType[], RopeCode["** ERROR **"]];

[type, code] _ LookUpEnumTypeVal1[lookup, nameB1, nameB2];
IF type = NIL THEN
BEGIN
PrintBadName[nameB1, "undefined or out of context -- expected a value"];
RETURN [BuildErrorType[], RopeCode["** ERROR **"]];
END;
RETURN [type, code];
END;

<<first arg shared with argTypes result>>
LookUpFunction: PUBLIC PROC[lookup: LookupContextNode, funName: NameNode] RETURNS[case: FunctionCase, argTypes: TypeListNode, 
resultTypes: TypeListNode] =
BEGIN
info: REF ANY;

IF IsErrorName[funName] THEN RETURN[base, BuildErrorTypeList[], BuildErrorTypeList[]];

info _ FindEntry[lookup.global.functions, funName];
IF info = NIL THEN
BEGIN
PrintBadName[funName, "undefined or out of context -- expected Function"];
RETURN[base, BuildErrorTypeList[], BuildErrorTypeList[]];
END;
WITH info SELECT FROM
rfi: RecFcnInfo => RETURN[recursive, rfi.argTypes, CopyTypeList[rfi.resultTypes]];
bfi: BaseFcnInfo => RETURN[base, bfi.argTypes, CopyTypeList[bfi.resultTypes]];
cfi: CedarFcnInfo => RETURN[base, cfi.argTypes, CopyTypeList[cfi.resultTypes]];
ENDCASE => ERROR;
END;

LookUpProduction: PUBLIC PROC[lookup: LookupContextNode, name: NameNode] RETURNS[INT] =
BEGIN
info: REF ANY;

IF IsErrorName[name] THEN ERROR UnrecoveredError;

info _ FindEntry[lookup.global.productions, name];
IF info = NIL THEN
BEGIN
PrintBadName[name, "undefined or out of context -- expected Production"];
ERROR UnrecoveredError;
END;
WITH info SELECT FROM
pi: ProductionInfo => RETURN[pi.index];
ENDCASE => ERROR;
END;

LookUpParseTree: PUBLIC PROC[lookup: LookupContextNode, name: NameNode] RETURNS[WholeFileNode] =
BEGIN
info: REF ANY;

IF IsErrorName[name] THEN ERROR UnrecoveredError;

info _ FindEntry[lookup.global.parseTrees, name];
IF info = NIL THEN
BEGIN
PrintBadName[name, "undefined or out of context -- expected ParseTree"];
ERROR UnrecoveredError;
END;

WITH info SELECT FROM
pti: ParseTreeInfo => RETURN [pti.tree];
ENDCASE => ERROR;
END;

EqualFunCase: PUBLIC PROC[c1, c2: FunctionCase] RETURNS[BOOLEAN] =
{RETURN[c1 = c2]};

CheckLegalRopeToken: PUBLIC PROC [lookup: LookupContextNode, rope: RopeNode] RETURNS[BOOLEAN] =
BEGIN
name: NameNode _ BuildRopeName[RopeFromRopeNode[rope]];
info: REF ANY _ FindEntry[lookup.global.grammarSymbols, name];
IF info = NIL THEN
BEGIN
PrintBadName[name, "undefined or out of context -- expected RopeToken"];
RETURN [TRUE];
END;
WITH info SELECT FROM
rti: RopeTokenInfo => RETURN [TRUE];
ENDCASE => {PrintError["type mismatch -- expected RopeToken but found ", GetTypeInfoRope[info]]; RETURN [TRUE]};
END;

PushLocalRSS: PUBLIC PROC[lookup: LookupContextNode, name: NameNode, type: TypeNode] RETURNS[LookupContextNode] =
BEGIN
IF IsErrorName[name] THEN RETURN [lookup];
BEGIN
item: RSSItem _ NEW[RSSItemBody_[name, type, lookup.rightSideSymbols]];
newLookup: LookupContextNode _ NEW[LookupContextNodeBody_[lookup.global, lookup.production, lookup.vars, item]];
RETURN[newLookup];
END;
END;

<<this is called during build expressions, and returns the abstract type associated with the concrete type.  i.e. for 
GenericTokens, returns the GenericToken type itself, for NonTerminals, returns the associated AbstractType, for rope terminals, it 
is an error.>>
LookUpGrammarSymbol: PUBLIC PROC[lookup: LookupContextNode, name: NameNode] RETURNS[TypeNode] =
BEGIN
info: REF ANY;

IF IsErrorName[name] THEN RETURN [BuildErrorType[]];

info _ FindEntry[lookup.global.grammarSymbols, name];
IF info # NIL THEN WITH info SELECT FROM
--rti: RopeTokenInfo => ERROR;
ntti: NonTerminalTokenInfo => RETURN[ntti.builds];
ENDCASE => {PrintBadName[name, "type mismatch -- expected GenericToken or NonTerminal but found ", GetTypeInfoRope[info]]; RETURN 
[BuildErrorType[]]};

-- might be a generic token or abstract type
info _ FindEntry[lookup.global.types, name];
WITH info SELECT FROM
gtti: GenericTokenTypeInfo => RETURN[BuildType[info]];
-- ati: AbstractTypeInfo => ERROR;  some day I want to have a concrete production build a pure value.  This requires some more work 
in Tran2B.1casaba.
ENDCASE => {PrintBadName[name, "type mismatch -- expected GenericToken or NonTerminal but found ", GetTypeInfoRope[info]]; RETURN 
[BuildErrorType[]]};
END;

LookUpAbstractProduction: PUBLIC PROC[lookup: LookupContextNode, name: NameNode] RETURNS[TypeNode, TypeListNode] =
BEGIN
info: REF ANY;

IF IsErrorName[name] THEN RETURN [BuildErrorType[], BuildErrorTypeList[]];

info _ FindEntry[lookup.global.abstProds, name];
IF info = NIL THEN
BEGIN
PrintBadName[name, "undefined or out of context -- expected AbstractProduction"];
RETURN [BuildErrorType[], BuildErrorTypeList[]];
END;
WITH info SELECT FROM
api: AbstractProductionInfo =>
BEGIN
type: TypeNode _ LookUpType[lookup, BuildName[api.abstractTypeId]]; -- why didnt I record the type
typeList: TypeListNode _ BuildEmptyTypeList[];

seeAName: PROC[argName: NameNode] =
{IF IsErrorName[argName] THEN typeList _ BuildErrorTypeList[]
ELSE
typeList _ AppendToTypeList[typeList, LookUpType[lookup, BuildName[GetNameIds[argName].id1]]]};

GenNames[api.rightSideNames, seeAName];
RETURN[type, typeList]
END;
ENDCASE => ERROR;
END;

LookUpRightSideSymbol: PUBLIC PROC[lookup: LookupContextNode, name: NameNode] RETURNS[TypeNode] =
BEGIN
IF IsErrorName[name] THEN RETURN [BuildErrorType[]];

FOR item: RSSItem _ lookup.rightSideSymbols, item.next WHILE item # NIL DO
IF EqualNames[item.name, name] THEN RETURN[item.type];
ENDLOOP;
RETURN[NIL]; -- this is not always an error condition
END;

FoundType: PUBLIC PROC[type: TypeNode] RETURNS[BOOLEAN] =
BEGIN
RETURN [type # NIL];
END;

EmptyRSContext: PUBLIC PROC[lookup: LookupContextNode] RETURNS[BOOLEAN] =
{RETURN[lookup.rightSideSymbols = NIL]};


-- usage info

UsageNode: TYPE = REF UsageNodeBody;
UsageNodeBody: PUBLIC TYPE = RECORD[
usageHT: HashTable];


UseInfo: TYPE = REF UseInfoBody;
UseInfoBody: TYPE = RECORD[
bits: ARRAY Use OF BOOLEAN];


BuildEmptyUsage: PUBLIC PROC RETURNS[UsageNode] =
{RETURN[NEW[UsageNodeBody_[CreateHashTable[10]]]]};

<<damages usage argument>>
RecordTypeUse: PUBLIC PROC[usage: UsageNode, type: TypeNode] RETURNS[UsageNode] =
BEGIN
fileName: Rope.ROPE;
info: REF ANY _ GetTypeInfo[type];
WITH info SELECT FROM
ati: AbstractTypeInfo => fileName _ ati.mesaDefFileName;
sbti: SimpleBaseTypeInfo => fileName _ sbti.mesaDefFileName;
gtti: GenericTokenTypeInfo => fileName _ gtti.mesaDefFileName;
pdcti: PreDefinedCedarTypeInfo => RETURN[usage];
cti: CedarTypeInfo => fileName _ cti.mesaDefFileName;
tti: TreeTypeInfo => RETURN[usage];
ebti: EnumeratedBaseTypeInfo => fileName _ ebti.mesaDefFileName;
ei: ErrorInfo => RETURN[usage];
ENDCASE => ERROR; 
RecordUse[usage, BuildRopeName[fileName], ref];
RETURN[usage]
END;

<<damages usage argument>>
RecordTypesUse: PUBLIC PROC[usage: UsageNode, types: TypeListNode] RETURNS[UsageNode] =
BEGIN
seeType: PROC[type: TypeNode] =
{usage _ RecordTypeUse[usage, type]};
GenTypeList[types, seeType];
RETURN[usage];
END;

<<damages usage argument>>
RecordFcnUse: PUBLIC PROC[usage: UsageNode, name: NameNode, use: Use, context: LookupContextNode] RETURNS[UsageNode] =
BEGIN
fileName: Rope.ROPE;
info: REF ANY;

IF IsErrorName[name] THEN RETURN [usage];

info _ FindEntry[context.global.functions, name];
IF info = NIL THEN
BEGIN
PrintBadName[name, "undefined or out of context -- expected Function"];
RETURN [usage];
END;
WITH info SELECT FROM
rfi: RecFcnInfo => fileName _ rfi.mesaDefFileName;
bfi: BaseFcnInfo => fileName _ bfi.mesaDefFileName;
cfi: CedarFcnInfo => fileName _ cfi.mesaDefFileName;
ENDCASE => ERROR;
RecordUse[usage, BuildRopeName[fileName], use];
RETURN[usage]
END;

<<damages usage argument>>
RecordAbstProdUse: PUBLIC PROC[usage: UsageNode, name: NameNode, use: Use, context: LookupContextNode] RETURNS[UsageNode] =
BEGIN
info1: REF ANY;

IF IsErrorName[name] THEN RETURN [usage];

info1 _ FindEntry[context.global.abstProds, name];
IF info1 = NIL THEN
BEGIN
PrintBadName[name, "undefined or out of context -- expected AbstractProduction"];
RETURN [usage];
END
ELSE IF ISTYPE[info1, ErrorInfo] THEN
RETURN [usage]
ELSE
BEGIN
info: AbstractProductionInfo _ NARROW[info1];
fileName: Rope.ROPE _ info.mesaDefFileName;
RecordUse[usage, BuildRopeName[fileName], use];
RETURN[usage];
END;
END;

<<damages usage argument>>
RecordGenericTokenUse: PUBLIC PROC[usage: UsageNode, name: NameNode, use: Use, context: LookupContextNode] RETURNS[UsageNode] =
BEGIN
info1: REF ANY;

IF IsErrorName[name] THEN RETURN [usage];

info1 _ FindEntry[context.global.types, name];
IF info1 = NIL THEN
BEGIN
PrintBadName[name, "undefined or out of context -- expected GenericToken"];
RETURN [usage];
END
ELSE IF ISTYPE[info1, ErrorInfo] THEN
RETURN [usage]
ELSE
BEGIN
info: GenericTokenTypeInfo _ NARROW[info1];
fileName: Rope.ROPE _ info.mesaDefFileName;
RecordUse[usage, BuildRopeName[fileName], use];
RETURN[usage];
END;
END;

<<damages usage argument>>
RecordLinkExport: PUBLIC PROC[usage: UsageNode, context: LookupContextNode] RETURNS[UsageNode] =
BEGIN
info: ControlModuleInfo _ NARROW[FindExistingEntry[context.global.types, BuildRopeName["$Control"]]];
RecordUse[usage, BuildRopeName["ParserDriver"], ref];
RecordUse[usage, BuildRopeName[info.mesaDefFileName], export];
RETURN[usage]
END;

RecordDefFileUse: PUBLIC PROC[usage: UsageNode, fNameText: Rope.ROPE, use: Use] RETURNS[UsageNode] =
BEGIN
RecordUse[usage, BuildRopeName[fNameText], use];
RETURN[usage];
END;

Hello: SIGNAL = CODE;
interestingFileName: Rope.ROPE _ NIL;
interestingUse: Use _ import;

RecordUse: PROC[usage: UsageNode, fileName: NameNode, use: Use] =
BEGIN
info: UseInfo;
nameText: Rope.ROPE; 

IF IsErrorName[fileName] THEN RETURN;

info _ NARROW[FindEntry[usage.usageHT, fileName]];
nameText _ GetNameInfo[fileName].text;
IF Rope.Equal[nameText, interestingFileName] AND use = interestingUse THEN Hello;
IF info = NIL THEN
BEGIN
info _ NEW[UseInfoBody_[[FALSE, FALSE, FALSE]]];
MakeEntry[usage.usageHT, fileName, info];
END;
info.bits[use] _ TRUE;
END;

BuildDefUseCode: PUBLIC PROC[usage: UsageNode, self: Rope.ROPE] RETURNS[directoryCode, openCode: MesaCodeNode] =
BEGIN
selfName: NameNode _ BuildRopeName[self];

ViewUseEntry: PROC[info: REF ANY, name: NameNode] =
BEGIN
useInfo: UseInfo _ NARROW[info];

IF IsErrorName[name] THEN RETURN;

IF EqualNames[name, selfName] THEN RETURN;
IF useInfo.bits[ref] OR useInfo.bits[import] THEN
BEGIN
newCode: MesaCodeNode;
IF directoryCode # NIL THEN newCode _ RopeCode1[",\N\T%g", NameFill[name]]
ELSE newCode _ RopeCode1["\N\T%g", NameFill[name]]; 
directoryCode _ ConcatCode2[directoryCode, newCode];
END;
IF useInfo.bits[export] AND NOT (useInfo.bits[ref] OR useInfo.bits[import]) THEN
BEGIN
newCode: MesaCodeNode;
IF directoryCode # NIL THEN newCode _ RopeCode1[",\N\T%g USING[]", NameFill[name]]
ELSE newCode _ RopeCode1["\N\T%g USING[]", NameFill[name]];
directoryCode _ ConcatCode2[directoryCode, newCode];
END;
IF useInfo.bits[ref] OR useInfo.bits[import] THEN
BEGIN
newCode: MesaCodeNode;
IF openCode # NIL THEN newCode _ RopeCode1[", %g", NameFill[name]]
ELSE newCode _ RopeCode1["%g", NameFill[name]];
openCode _ ConcatCode2[openCode, newCode];
END;
END;

directoryCode _ BuildEmptyCode[];
openCode _ BuildEmptyCode[];

EnumerateHashTable[usage.usageHT, ViewUseEntry];


IF NOT TestEmptyCode[openCode] THEN openCode _ RopeCode1["OPEN %g;\N", CodeFill[openCode]];

RETURN[
RopeCode1["DIRECTORY%g;\N\N", CodeFill[directoryCode]],
openCode];
 
END;

BuildImplUseCode: PUBLIC PROC[usage: UsageNode] RETURNS[directoryCode, importsCode, exportsCode, openCode: MesaCodeNode] =
BEGIN

ViewUseEntry: PROC[info: REF ANY, name: NameNode] =
BEGIN
useInfo: UseInfo _ NARROW[info];

IF IsErrorName[name] THEN RETURN;

IF useInfo.bits[ref] OR useInfo.bits[import] THEN
BEGIN
newCode: MesaCodeNode;
IF directoryCode # NIL THEN newCode _ RopeCode1[",\N\T%g", NameFill[name]]
ELSE newCode _ RopeCode1["\N\T%g", NameFill[name]]; 
directoryCode _ ConcatCode2[directoryCode, newCode];
END;
IF useInfo.bits[export] AND NOT (useInfo.bits[ref] OR useInfo.bits[import]) THEN
BEGIN
newCode: MesaCodeNode;
IF directoryCode # NIL THEN newCode _ RopeCode1[",\N\T%g USING[]", NameFill[name]]
ELSE newCode _ RopeCode1["\N\T%g USING[]", NameFill[name]];
directoryCode _ ConcatCode2[directoryCode, newCode];
END;
IF useInfo.bits[import] THEN
BEGIN
newCode: MesaCodeNode;
IF importsCode # NIL THEN newCode _ RopeCode1[", %g", NameFill[name]]
ELSE newCode _ RopeCode1["%g", NameFill[name]];
importsCode _ ConcatCode2[importsCode, newCode];
END;
IF useInfo.bits[export] THEN
BEGIN
newCode: MesaCodeNode;
IF exportsCode # NIL THEN newCode _ RopeCode1[", %g", NameFill[name]]
ELSE newCode _ RopeCode1["%g", NameFill[name]];
exportsCode _ ConcatCode2[exportsCode, newCode];
END;

IF useInfo.bits[ref] OR useInfo.bits[import] THEN
BEGIN
newCode: MesaCodeNode;
IF openCode # NIL THEN newCode _ RopeCode1[", %g", NameFill[name]]
ELSE newCode _ RopeCode1["%g", NameFill[name]];
openCode _ ConcatCode2[openCode, newCode];
END;
END;

directoryCode _ BuildEmptyCode[];
importsCode _ BuildEmptyCode[];
exportsCode _ BuildEmptyCode[];
openCode _ BuildEmptyCode[];

EnumerateHashTable[usage.usageHT, ViewUseEntry];

IF NOT TestEmptyCode[importsCode] THEN importsCode _ RopeCode1[" IMPORTS %g", CodeFill[importsCode]];
IF NOT TestEmptyCode[exportsCode] THEN exportsCode _ RopeCode1[" EXPORTS %g", CodeFill[exportsCode]];
IF NOT TestEmptyCode[openCode] THEN openCode _ RopeCode1["OPEN %g;\N", CodeFill[openCode]];


RETURN[
RopeCode1["DIRECTORY%g;\N\N", CodeFill[directoryCode]],
importsCode,
exportsCode,
openCode];
 
END;

<<to be marked as damaging its argument>>
FakeUsageCopy: PUBLIC PROC[usage: UsageNode] RETURNS[UsageNode] =
{RETURN[usage]};
<<>>
<<>>
<<context print code>>

ShowIndent: PROC[indent: CARDINAL, on: IO.STREAM] =
BEGIN
FOR I: CARDINAL IN [0..indent) DO IO.PutRope[on, " "] ENDLOOP;
END;

InspectContext: PUBLIC PROC[lookup: LookupContextNode] RETURNS[BOOLEAN] =
BEGIN
IF FALSE THEN ShowContext[lookup.global, 0, ThreeC4Support.GetReportStream[]];
RETURN[TRUE];
END;

ShowContext: PUBLIC PROC[context: ContextNode, indent: CARDINAL, on: IO.STREAM] =
BEGIN
IF context = NIL THEN RETURN;
ShowHashTable[context.types, indent, on, ShowTypeInfo];
ShowHashTable[context.abstProds, indent, on, ShowAbstractProductionInfo];
ShowHashTable[context.functions, indent, on, ShowFunctionInfo];
ShowHashTable[context.values, indent, on, ShowValueInfo];
END;

ShowHashTable: PROC[table: HashTable, indent: CARDINAL, on: IO.STREAM, show: PROC[REF ANY, CARDINAL, IO.STREAM]] =
BEGIN
SeeOneEntry: PROC[info: REF ANY, name: NameNode] =
BEGIN
IF IsErrorName[name] THEN {IO.PutRope[on, "** ERROR **"]; RETURN};
ShowIndent[indent, on]; ShowName[name, on]; IO.PutRope[on, "\N"];
show[info, indent+5, on];
END;
EnumerateHashTable[table, SeeOneEntry];
END;

ShowTypeInfo: PROC[info: REF ANY, indent: CARDINAL, on: IO.STREAM] =
BEGIN
WITH info SELECT FROM
ati: AbstractTypeInfo => ShowAbstractTypeInfo[ati, indent, on];
sbti: SimpleBaseTypeInfo => ShowSimpleBaseTypeInfo[sbti, indent, on];
gtti: GenericTokenTypeInfo => ShowGenericTokenTypeInfo[gtti, indent, on];
pdcti: PreDefinedCedarTypeInfo => ShowPreDefinedCedarTypeInfo[pdcti, indent, on];
cti: CedarTypeInfo => ShowCedarTypeInfo[cti, indent, on];
tti: TreeTypeInfo => ShowTreeTypeInfo[tti, indent, on];
ebti: EnumeratedBaseTypeInfo => ShowEnumeratedBaseTypeInfo[ebti, indent, on];
cmi: ControlModuleInfo => ShowControlModuleInfo[cmi, indent, on];
ei: ErrorInfo => ShowErrorInfo[ei, indent, on];
ENDCASE => ERROR;
END;

ShowErrorInfo: PROC[info: REF ANY, indent: CARDINAL, on: IO.STREAM] = 
BEGIN
IO.PutRope[on, "** ERROR **"];
END;

ShowFunctionInfo: PROC[info: REF ANY, indent: CARDINAL, on: IO.STREAM] = 
BEGIN
WITH info SELECT FROM
rfib: RecFcnInfo => ShowRecFcnInfo[rfib, indent, on];
bfib: BaseFcnInfo => ShowBaseFcnInfo[bfib, indent, on];
ENDCASE => ERROR;
END;

ShowValueInfo: PROC[info: REF ANY, indent: CARDINAL, on: IO.STREAM] = 
BEGIN
WITH info SELECT FROM
arssi: AbstractRightSideSymbolInfo => ShowAbstractRightSideSymbolInfo[arssi, indent, on];
ENDCASE => ERROR;
END;

ShowAbstractTypeInfo: PROC[info: AbstractTypeInfo, indent: CARDINAL, on: IO.STREAM] =
BEGIN
ShowIndent[indent, on]; IO.PutF[on, "is an abstract type, mesaDefFileName = %g\N", IO.rope[info.mesaDefFileName]];
ShowCodeNameText[info.textCodeName, indent+3, on]; 
ShowIndent[indent, on]; IO.PutRope[on, "\Tdefined recursive functions = ("];
ShowNameList[info.recFcnNameList, on];
IO.PutRope[on, ")\N"];
END;

ShowSimpleBaseTypeInfo: PROC[info: SimpleBaseTypeInfo, indent: CARDINAL, on: IO.STREAM] =
BEGIN
ShowIndent[indent, on]; IO.PutF[on, "\Tis a simple base type, mesaDefFileName = %g\N", IO.rope[info.mesaDefFileName]];
ShowCodeNameText[info.textCodeName, indent+3, on];
END;

ShowGenericTokenTypeInfo: PROC[info: GenericTokenTypeInfo, indent: CARDINAL, on: IO.STREAM] =
BEGIN
ShowIndent[indent, on]; IO.PutF[on, "\Tis a generic token type, mesaDefFileName = %g\N", IO.rope[info.mesaDefFileName]];
ShowCodeNameText[info.textCodeName, indent+3, on];
END;

ShowPreDefinedCedarTypeInfo: PROC[info: PreDefinedCedarTypeInfo, indent: CARDINAL, on: IO.STREAM] =
BEGIN
ShowIndent[indent, on]; IO.PutF[on, "\Tis a pre defined Cedar type\N"];
ShowCodeNameText[info.textCodeName, indent+3, on];
END;

ShowCedarTypeInfo: PROC[info: CedarTypeInfo, indent: CARDINAL, on: IO.STREAM] =
BEGIN
ShowIndent[indent, on]; IO.PutF[on, "\Tis a Cedar type, mesaDefFileName = %g\N", IO.rope[info.mesaDefFileName]];
ShowCodeNameText[info.textCodeName, indent+5, on];
END;

ShowTreeTypeInfo: PROC[info: TreeTypeInfo, indent: CARDINAL, on: IO.STREAM] =
BEGIN
ShowIndent[indent, on]; IO.PutF[on, "\Tis a Tree type\N"];
ShowCodeNameText[info.textCodeName, indent+5, on];
END;

ShowEnumeratedBaseTypeInfo: PROC[info: EnumeratedBaseTypeInfo, indent: CARDINAL, on: IO.STREAM] =
BEGIN
ShowIndent[indent, on]; IO.PutF[on, "\Tis an Enumerated Base Type, mesaDefFileName = %g\N", IO.rope[info.mesaDefFileName]];
ShowCodeNameText[info.textCodeName, indent+5, on];
ShowIndent[indent+5, on]; IO.PutRope[on, "value names = ("];
ShowNameList[info.names, on];
IO.PutF[on, ")\N"];
END;

ShowControlModuleInfo: PROC[info: ControlModuleInfo, indent: CARDINAL, on: IO.STREAM] =
BEGIN
ShowIndent[indent, on]; IO.PutF[on, "\Tis control module info, mesaDefFileName = %g\N", IO.rope[info.mesaDefFileName]];
END;

ShowRecFcnInfo: PROC[info: RecFcnInfo, indent: CARDINAL, on: IO.STREAM] =
BEGIN
ShowIndent[indent, on]; IO.PutF[on, "\Tis a recursive function, mesaDefFileName = %g\N", IO.rope[info.mesaDefFileName]];
ShowIndent[indent, on]; IO.PutF[on, "\Twith arg types = ("];
ShowTypeList[info.argTypes, on];
IO.PutF[on, "), result types = ("];
ShowTypeList[info.resultTypes, on];
IO.PutF[on, ")\N"];
ShowFcnDefGraph[info.defGraph, indent+2, on];
END;

ShowBaseFcnInfo: PROC[info: BaseFcnInfo, indent: CARDINAL, on: IO.STREAM] =
BEGIN
ShowIndent[indent, on]; IO.PutF[on, "\Tis a base function, mesaDefFileName = %g\N", IO.rope[info.mesaDefFileName]];
ShowIndent[indent, on]; IO.PutF[on, "\Twith arg types = ("];
ShowTypeList[info.argTypes, on];
IO.PutF[on, "), result types = ("];
ShowTypeList[info.resultTypes, on];
IO.PutF[on, ")\N"];
ShowFcnDefGraph[info.defGraph, indent+2, on];
END;

ShowAbstractProductionInfo: PROC[api: REF ANY, indent: CARDINAL, on: IO.STREAM] =
BEGIN
info: AbstractProductionInfo _ NARROW[api];
ShowIndent[indent, on]; IO.PutF[on, "is an abstract production, mesaDefFileName = %g\N", IO.rope[info.mesaDefFileName]];
ShowIndent[indent+5, on]; IO.PutF[on, "type = %g, case = %g\N", IO.rope[info.abstractTypeId.text], IF info.caseId # NIL THEN 
IO.rope[info.caseId.text] ELSE IO.rope[""]];
ShowIndent[indent+5, on]; IO.PutRope[on, "right side names = ("];
ShowNameList[info.rightSideNames, on];
IO.PutRope[on, ")\N"];
ShowIndent[indent+5, on]; IO.PutRope[on, "local context follows:\N"];
ShowContext[info.productionContext.context, indent+10, on];
END;

ShowAbstractRightSideSymbolInfo: PROC[info: AbstractRightSideSymbolInfo, indent: CARDINAL, on: IO.STREAM] =
BEGIN
ShowIndent[indent, on]; IO.PutRope[on, "type = "];
ShowName[info.typeName, on]; IO.PutRope[on, "\N"];
END;

ShowCodeName: PROC[codeName: MesaCodeNode, indent: CARDINAL, on: IO.STREAM] =
BEGIN
ShowIndent[indent, on];
IO.PutF[on, "with codeName = "];
ShowCode[codeName, on];
IO.PutRope[on, "\N"];
END;

ShowCodeNameText: PROC[text: Rope.ROPE, indent: CARDINAL, on: IO.STREAM] =
BEGIN
ShowIndent[indent, on];
IO.PutF[on, "with codeName = %g\N", IO.rope[text]];
END;

ShowId: PROC[id: IdentifierNode, on: IO.STREAM] =
{IO.PutF[on, "%g", IO.rope[id.text]]};


-- some error recovery base functions

BPrintError: PUBLIC PROC [b: BOOLEAN, msg: Rope.ROPE] RETURNS [BOOLEAN] =
BEGIN
IF NOT b THEN PrintError[msg];
RETURN [b];
END;


BPrintBadName: PUBLIC PROC [b: BOOLEAN, name: NameNode, msg: Rope.ROPE] RETURNS [BOOLEAN] =
BEGIN
IF NOT b THEN PrintBadName[name, msg];
RETURN [b];
END;

BAbort: PUBLIC PROC [b: BOOLEAN] RETURNS [BOOLEAN] =
BEGIN
IF NOT b THEN ERROR UnrecoveredError;
RETURN [b];
END;

True: PUBLIC PROC RETURNS [BOOLEAN] = {RETURN [TRUE]};

False: PUBLIC PROC RETURNS [BOOLEAN] = {RETURN [FALSE]};

MarkErrors: PUBLIC PROC RETURNS [BOOLEAN] =
BEGIN
globalEnv:  GlobalEnvHandle;

globalEnv _ GetGlobalEnv[];
globalEnv.errorMark _ globalEnv.errorCount;
RETURN [TRUE];
END;

AreErrors: PUBLIC PROC RETURNS [BOOLEAN] =
BEGIN
globalEnv:  GlobalEnvHandle;

globalEnv _ GetGlobalEnv[];
RETURN [globalEnv.errorCount > globalEnv.errorMark];
END;


END..