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];
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;
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;
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;
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];
MakeEntry[context.types, type, NEW[PreDefinedCedarTypeInfoBody←[id1, RopeFromCode[codeName]]]];
RETURN[context];
END;
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;
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;
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;
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;
RecordControlModule: PUBLIC PROC[context: ContextNode, mesaDefFileName: Rope.ROPE] RETURNS[ContextNode] =
BEGIN
MakeEntry[context.types, BuildRopeName["$Control"], NEW[ControlModuleInfoBody←[NIL, mesaDefFileName]]];
RETURN[context];
END;
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];
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];
-- 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]]]]};
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;
RecordTypesUse: PUBLIC PROC[usage: UsageNode, types: TypeListNode] RETURNS[UsageNode] =
BEGIN
seeType: PROC[type: TypeNode] =
{usage ← RecordTypeUse[usage, type]};
GenTypeList[types, seeType];
RETURN[usage];
END;
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;
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;
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;
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..