ParserPrivate1Impl.mesa
Copyright © 1986 by Xerox Corporation. All rights reserved.
Bhargava, August 9, 1986 2:56:46 pm PDT
Bill Jackson (bj) September 25, 1986 3:43:40 am PDT
DIRECTORY
Convert USING [CardFromRope, IntFromRope],
FS USING [StreamOpen],
HashTable USING [Create, EachPairAction, Fetch, HashRope, Insert, Pairs, RopeEqual, Table, Value],
IO USING [card, int, rope, BreakProc, CharClass, Close, CR, GetTokenRope, PutF, PutFR, STREAM],
ParserPrivateDef USING [MkCType, SendError],
Rope USING [ROPE, Cat, Concat, Equal, Length, Substr],
RopeList USING [Cons, Map],
SiroccoPrivate USING [AquireState, CComponent, CComponentBody, CType, CTypeBody, DirectoryEntry, FunctionList, Handle, TABLES, TablesBody, Variable],
WartDef USING [Generic, identifierNode, numberDNode, numberHNode, numberONode, RopeNode];
ParserPrivate1Impl: CEDAR PROGRAM
IMPORTS ParserPrivateDef, Convert, FS, HashTable, IO, Rope, RopeList, SiroccoPrivate
EXPORTS ParserPrivateDef, SiroccoPrivate ~ {
OPEN SiroccoPrivate, ParserPrivateDef;
Copied Types
EachPairAction: TYPE ~ HashTable.EachPairAction;
numberHNode: TYPE ~ WartDef.numberHNode;
numberDNode: TYPE ~ WartDef.numberDNode;
numberONode: TYPE ~ WartDef.numberONode;
Generic: TYPE ~ WartDef.Generic;
identifierNode: TYPE ~ WartDef.identifierNode;
ROPE: TYPE ~ Rope.ROPE;
RopeNode: TYPE ~ WartDef.RopeNode;
Value: TYPE ~ HashTable.Value;
Procs
AddOne: PUBLIC PROC [in: INT] RETURNS [out: INT] ~ {
out ← in+1;
};
card: PUBLIC PROC [in: INT] RETURNS [out: CARD] ~ {
out ← CARD[in];
};
int: PUBLIC PROC [in: CARD] RETURNS [out: INT] ~ {
out ← INT[in];
};
nat: PUBLIC PROC [in: INT] RETURNS [out: NAT] ~ {
out ← NAT[in];
};
CheckResultsForSourceAndSink: PUBLIC PROC [list: CComponent] RETURNS [final: INT] ~ {
WHILE (list # NIL) DO
IF (Rope.Equal[list.type, "SOURCE"])
OR Rope.Equal[list.type, "SINK"]
THEN [] ← SendError["Result Has Source or Sink"];
list ← list.sibling
ENDLOOP;
final ← -1;
};
CheckCanonicalType: PUBLIC PROC [r1, r2: ROPE, t: TABLES] RETURNS [checked: TABLES] ~ {
IF NOT (Rope.Equal[r1, r2])
THEN [] ← SendError[Rope.Cat["Type Mismatch Expected ", r2, " found ", r1]];
checked ← t;
};
ClassToRope: PROC [class: Generic] RETURNS [rope: ROPE] ~ {
SELECT class FROM
array => rope ← "ARRAY";
procedure => rope ← "PROCEDURE";
sequence => rope ← "SEQUENCE";
boolean => rope ← "BOOLEAN";
cardinal => rope ← "CARDINAL";
longCardinal => rope ← "LONGCARDINAL";
integer => rope ← "INTEGER";
longInteger => rope ← "LONGINTEGER";
string => rope ← "STRING";
unspecified => rope ← "UNSPECIFIED";
error => rope ← "ERROR";
enumeration => rope ← "ENUMERATION";
record => rope ← "RECORD";
choice => rope ← "CHOICE";
bulkDataSource => rope ← "SOURCE";
bulkDataSink => rope ← "SINK";
ENDCASE => ERROR;
};
Collapse: PUBLIC PROC ~ {
failure: BOOLEAN;
outStream: IO.STREAM;
tables: TABLES;
h: SiroccoPrivate.Handle;
AddUsedTypes: EachPairAction ~ {
success: BOOLEAN;
type: Value;
ctype: CType;
entry: REF DirectoryEntry;
TraverseCtype: PUBLIC PROC [type: CType] ~ {
list: CComponent ← type.children;
success: BOOLEAN;
value: Value;
ctype: CType;
WHILE (list # NIL) DO
IF NOT (Rope.Equal["", list.type] OR (list.type = NIL))
THEN {
[success, value] ← HashTable.Fetch[tables.typeTable, list.type];
IF HashTable.Insert[tables.condensedTypeTable, list.type, value]
THEN {
ctype ← NARROW[value];
TraverseCtype[ctype];
};
};
list ← list.sibling;
ENDLOOP;
};
entry ← NARROW[value];
[success, type] ← HashTable.Fetch[tables.typeTable, entry.type];
IF HashTable.Insert[tables.condensedTypeTable, entry.type, type]
THEN {
ctype ← NARROW[type];
TraverseCtype[ctype];
}
ELSE RETURN[FALSE];
};
ConstantOrVariable: EachPairAction ~ {
type: CType ← NARROW[value];
list: CComponent ← type.children;
success: BOOLEAN;
unresolved: BOOLEAN ← TRUE;
siblingValue: Value;
siblingType: CType;
SELECT type.class FROM
sequence,
string => {
type.variable ← variable;
};
integer,
longInteger,
cardinal,
longCardinal,
boolean,
procedure,
error,
unspecified,
enumeration => {
type.variable ← constant;
};
ENDCASE => {
IF (type.variable = unvisited) THEN
WHILE unresolved DO
IF (list = NIL)
THEN {
type.variable ← constant;
unresolved ← FALSE;
}
ELSE {
[success, siblingValue] ← HashTable.Fetch[tables.condensedTypeTable, list.type];
siblingType ← NARROW[siblingValue];
IF siblingType.variable = unvisited
THEN success ← ConstantOrVariable[list.type, siblingValue];
IF siblingType.variable = variable
THEN {
type.variable ← variable;
unresolved ← FALSE;
}
ELSE list ← list.sibling;
};
ENDLOOP;
};
};
WriteOutLocalTableEntry: EachPairAction ~ {
keyRope: ROPE ← NARROW[key];
entry: REF DirectoryEntry ← NARROW[value];
FuctionsToDisk: PROC[name: ROPE] ~ {
IO.PutF[outStream, "%g|",
IO.rope[name]
];
};
IO.PutF[outStream, "|%g|%g|%g |\nFunctions|",
IO.rope[keyRope],
IO.rope[entry.type],
IO.rope[entry.constant]
];
RopeList.Map[entry.functions, FuctionsToDisk];
IO.PutF[outStream, "~~~~~\n"]
};
WriteOutTypeTableEntry: EachPairAction ~ {
type: CType ← NARROW[value];
keyRope: ROPE ← NARROW[key];
list: CComponent ← type.children;
IO.PutF[outStream, "TYPE|%g|%g|%g|%g|\n",
IO.rope[keyRope],
IO.rope[ClassToRope[type.class]],
IO.rope[VarToRope[type.variable]],
IO.card[type.bound]
];
WHILE (list # NIL) DO
IO.PutF[outStream, "%g |%g |%g |\n",
IO.rope[list.name],
IO.int[list.val],
IO.rope[list.type]
];
list ← list.sibling;
ENDLOOP;
};
WriteOutFunctionTableEntry: EachPairAction ~ {
IO.PutF[outStream, "%g|%g\n",
IO.rope[NARROW[key]],
IO.rope[NARROW[value]]
]
};
h ← SIGNAL SiroccoPrivate.AquireState;
tables ← h.allTheTables;
failure ← HashTable.Pairs[tables.localTable, AddUsedTypes];
failure ← HashTable.Pairs[tables.condensedTypeTable, ConstantOrVariable];
outStream ← FS.StreamOpen[Rope.Concat[h.programKey,"Tables"], $create];
IO.PutF[outStream, "LocalTables\n"];
failure ← HashTable.Pairs[tables.localTable, WriteOutLocalTableEntry];
IO.PutF[outStream, "\nTypeTables\n"];
failure ← HashTable.Pairs[tables.condensedTypeTable, WriteOutTypeTableEntry];
IO.PutF[outStream, "\nTYPE|.\n"];
IO.PutF[outStream, "\nFunctions\n"];
failure ← HashTable.Pairs[tables.functionTable, WriteOutFunctionTableEntry];
IO.PutF[outStream, "\n.\n"];
IO.Close[outStream];
};
CompareTypes: PUBLIC PROC [first: CType, second: CType, tables: TABLES] RETURNS [INT ← 1] ~ {
CompareCComponents: PROC [first: CComponent, second: CComponent] ~ {
firstCtype: CType;
secondCtype: CType;
successful: BOOLEAN;
value: Value;
IF (first = NIL OR second = NIL)
AND NOT (first = NIL AND second = NIL)
THEN ERROR
ELSE
IF first = NIL THEN RETURN;
IF NOT Rope.Equal[first.name, second.name]
OR first.val # second.val
THEN
[] ← SendError["Type Mismatch"];
IF NOT Rope.Equal[first.type, second.type] THEN {
[successful, value] ← HashTable.Fetch[tables.typeTable, first.type];
firstCtype ← NARROW[value];
[successful, value] ← HashTable.Fetch[tables.typeTable, second.type];
secondCtype ← NARROW[value];
[] ← CompareTypes[firstCtype, secondCtype, tables];
};
CompareCComponents[first.sibling, second.sibling];
};
Check on status of unspecified
SELECT first.class FROM
boolean,
cardinal,
longCardinal,
integer,
longInteger,
string,
unspecified => {
IF (first.class = second.class)
THEN RETURN[1--Just to return an INT--]
ELSE [] ← SendError["Type Mismatch"];
};
enumeration,
record,
choice => {
RETURN[1--Just to return an INT--]; -- Comparison of names already done
};
array,
sequence => {
IF (first.class = second.class)
AND (first.bound = second.bound)
THEN {
CompareCComponents[first.children, second.children];
IF (GetLengthOfCComponentList[first.children, first.bound] # 0)
THEN ERROR;
}
ELSE {
RETURN[1--Just to return an INT--];
};
};
procedure,
error => {
IF (second.class = cardinal)
THEN RETURN[1--Just to return an INT--]
ELSE {
IF (first.class = second.class)
AND (first.bound = second.bound)
THEN {
CompareCComponents[first.children, second.children];
RETURN[1--Just to return an INT--];
}
ELSE
[] ← SendError["Type Mismatch"];
};
};
ENDCASE => {
[] ← SendError["Type Mismatch"];
};
RETURN[1--Just to return an INT--];
};
CopyRope: PUBLIC PROC [in:ROPE] RETURNS [out: ROPE] ~ {
out ← in;
};
CopyTables: PUBLIC PROC [t1: TABLES] RETURNS [t2: TABLES] ~ {
t2 ← t1;
};
CopyFunctionList: PUBLIC PROC [in: FunctionList] RETURNS [out: FunctionList] ~ {
out ← in;
};
CopyAll: PUBLIC PROC [in1: ROPE, in2: FunctionList, in3: TABLES] RETURNS [out1: ROPE, out2: FunctionList, out3: TABLES] ~ {
out1 ← in1;
out2 ← in2;
out3 ← in3;
};
CreateCanonicalKey: PUBLIC PROC [id: identifierNode, progno: numberDNode, verno: numberDNode] RETURNS [key: ROPE] ~ {
h: SiroccoPrivate.Handle;
h ← SIGNAL SiroccoPrivate.AquireState;
h.versionNo ← Convert.IntFromRope[verno.text];
h.programNo ← Convert.IntFromRope[progno.text];
h.programName ← id.text;
key ← h.programKey ← IO.PutFR["%gP%gV%g.",
IO.rope[id.text],
IO.int[Convert.IntFromRope[progno.text]], -- to canonicalize it
IO.int[Convert.IntFromRope[verno.text]] -- ditto
];
};
CreateKey: PUBLIC PROC [id: identifierNode] RETURNS [key: ROPE] ~ {
key ← id.text;
};
CreateTables: PUBLIC PROC RETURNS [t: TABLES] ~ {
h: SiroccoPrivate.Handle;
NewTable: PROC RETURNS [new: HashTable.Table] ~ {
new ← HashTable.Create[equal~HashTable.RopeEqual, hash~HashTable.HashRope];
};
InsertValue: PROC [key: ROPE, type: Generic] RETURNS [ok: BOOLEAN] ~ {
ok ← HashTable.Insert[h.allTheTables.typeTable, key, MkCType[type, 0, NIL]]
};
h ← SIGNAL SiroccoPrivate.AquireState;
h.allTheTables ← NEW[TablesBody];
h.allTheTables.globalTable ← NewTable[];
h.allTheTables.typeTable ← NewTable[];
h.allTheTables.localTable ← NewTable[];
h.allTheTables.unresolvedTypeTable ← NewTable[];
h.allTheTables.unresolvedConstantTable ← NewTable[];
h.allTheTables.workTable ← NewTable[];
h.allTheTables.directory ← NewTable[];
h.allTheTables.errors ← NewTable[];
h.allTheTables.procedures ← NewTable[];
h.allTheTables.condensedTypeTable ← NewTable[];
h.allTheTables.functionTable ← NewTable[];
h.allTheTables.condensedFunctionTable ← NewTable[];
h.allTheTables.madeUpNameTable ← NewTable[];
Put Predefined Values: integer, boolean, etc. into the table
IF NOT (InsertValue["BOOLEAN", boolean]) THEN ERROR;
IF NOT (InsertValue["CARDINAL", cardinal]) THEN ERROR;
IF NOT (InsertValue["LONGCARDINAL", longCardinal]) THEN ERROR;
IF NOT (InsertValue["INTEGER", integer]) THEN ERROR;
IF NOT (InsertValue["LONGINTEGER", longInteger]) THEN ERROR;
IF NOT (InsertValue["STRING", string]) THEN ERROR;
IF NOT (InsertValue["UNSPECIFIED", unspecified]) THEN ERROR;
IF NOT (InsertValue["SOURCE", bulkDataSource]) THEN ERROR;
IF NOT (InsertValue["SINK", bulkDataSink]) THEN ERROR;
RETURN[h.allTheTables] ;
};
DiskToTable: PUBLIC PROC [t1: TABLES, id: identifierNode, progno: numberDNode, verno: numberDNode] RETURNS [new: TABLES] ~ {
info: REF DirectoryEntry;
keyRope: ROPE;
sibling: CComponent;
sourceStream: IO.STREAM ← FS.StreamOpen[Rope.Concat[ProgramFile[], ".Tables"]];
successful: BOOLEAN;
table: HashTable.Table ← HashTable.Create[equal~HashTable.RopeEqual, hash~HashTable.HashRope];
token: ROPE;
type: CType;
ProgramFile: PROC RETURNS [name: ROPE] ~ {
name ← IO.PutFR["%gP%gV%g",
IO.rope[id.text],
IO.int[Convert.IntFromRope[progno.text]],
IO.int[Convert.IntFromRope[verno.text]]
];
};
NextToken: PROC RETURNS [text: ROPE] ~ {
charsSkipped: INT;
[text, charsSkipped] ← IO.GetTokenRope[sourceStream, Control];
};
Control: IO.BreakProc ~ {
SELECT char FROM
IO.CR, '| => RETURN[sepr];
ENDCASE => RETURN[other];
};
Normalize: PROC [arg: ROPE] RETURNS [res: ROPE] ~ {
length: INT ← Rope.Length[arg];
res ← IF (length = 1)
THEN ""
ELSE Rope.Substr[arg, 0, length-1];
};
TokenToInt: PROC [arg: ROPE] RETURNS [res: INT] ~ {
length: INT ← Rope.Length[arg];
res ← IF (length = 1)
THEN 0
ELSE Convert.IntFromRope[Rope.Substr[arg, 0, length-1]];
};
[] ← HashTable.Insert[t1.directory, id.text, ProgramFile[]];
token ← NextToken[]; -- Skip Heading
keyRope ← token ← NextToken[]; -- Get First Key
WHILE (NOT Rope.Equal[keyRope, "TypeTables"]) DO -- While Local Table is not exhausted
info ← NEW[DirectoryEntry];
info.type ← token ← NextToken[];
info.constant ← Normalize[token ← NextToken[]];
token ← NextToken[]; -- Throw away Function Header
token ← NextToken[];
WHILE NOT Rope.Equal[token, "~~~~~"] DO
info.functions ← RopeList.Cons[info.functions, token];
token ← NextToken[];
ENDLOOP;
info.value ← NIL;
successful ← HashTable.Insert[table, keyRope, info];
keyRope ← token ← NextToken[];
ENDLOOP;
[] ← HashTable.Insert[t1.globalTable, id.text, table]; -- Local Tables over
token ← NextToken[]; -- Skip Type Heading
keyRope ← token ← NextToken[]; -- Get First Type Name
WHILE (NOT Rope.Equal[keyRope, "."]) DO -- Process Type Table
type ← NEW[CTypeBody]; -- Allocate CType
type.class ← RopeToClass[token ← NextToken[]]; -- Get Class
type.variable ← RopeToVar[token ← NextToken[]]; -- Get variable status
type.bound ← Convert.CardFromRope[token ← NextToken[]]; -- Get bound
token ← NextToken[];
IF NOT Rope.Equal[token, "TYPE"] THEN { -- Are there any children
sibling ← NEW[CComponentBody];
type.children ← sibling --First Child
};
WHILE (NOT Rope.Equal[token, "TYPE"]) DO
sibling.name ← Normalize[token];
sibling.val ← TokenToInt[token ← NextToken[]];
sibling.type ← Normalize[token ← NextToken[]];
token ← NextToken[];
IF (NOT Rope.Equal[token, "TYPE"]) THEN {
sibling.sibling ← NEW[CComponentBody]; --Rest Of the Children
sibling ← sibling.sibling;
}
ENDLOOP;
[] ← HashTable.Insert[t1.typeTable, keyRope, type]; -- Enter Type
keyRope ← token ← NextToken[]; -- Get Next Type Name
ENDLOOP;
token ← NextToken[]; --Skip Header
keyRope ← token ← NextToken[];
WHILE (NOT Rope.Equal[keyRope, "."]) DO
token ← NextToken[];
[] ← HashTable.Insert[t1.functionTable, keyRope, token];
keyRope ← token ← NextToken[];
ENDLOOP;
new ← t1;
};
FetchFromGlobalTable: PUBLIC PROC [t1: TABLES, key: ROPE] RETURNS [value: HashTable.Table] ~ {
successful: BOOLEAN;
temp: Value;
[successful, temp] ← HashTable.Fetch[t1.globalTable, key];
IF (NOT successful) THEN ERROR;
value ← NARROW[temp];
};
GetCardFromDecimal: PUBLIC PROC [decimal: numberDNode] RETURNS [card: CARD] ~ {
card ← Convert.CardFromRope[decimal.text];
};
GetCardFromHex: PUBLIC PROC [hex: numberHNode] RETURNS [card: CARD] ~ {
card ← Convert.CardFromRope[hex.text, 16];
};
GetCardFromOctal: PUBLIC PROC [octal: numberONode] RETURNS [card: CARD] ~ {
card ← Convert.CardFromRope[octal.text, 8];
};
GetCType: PUBLIC PROC [ id: identifierNode, list: CComponent, tables: TABLES] RETURNS [type: CType ← NIL, name: ROPE ← ""] ~ {
successful: BOOLEAN;
temp: Value;
templist: CComponent;
templist ← list;
WHILE (templist # NIL)
AND (NOT Rope.Equal[id.text, templist.name]) DO
templist ← templist.sibling;
ENDLOOP;
IF (templist = NIL)
THEN [] ← SendError["Type Mismatch"]
ELSE {
name ← templist.type;
[successful, temp] ← HashTable.Fetch[tables.typeTable, name];
IF NOT successful
THEN ERROR -- COMILER ERROR
ELSE type ← NARROW[temp];
};
};
GetLengthOfCComponentList: PUBLIC PROC [list: CComponent, initial: INT] RETURNS [final: INT] ~ {
WHILE (list # NIL) DO
initial ← initial - 1;
list ← list.sibling
ENDLOOP;
final ← 0 - initial;
IF (final >= 0)
THEN {
final ← 0 - initial;
RETURN;
}
ELSE [] ← SendError["Type Mismatch"]; -- LIST OF INCORRECT LENGTH
final ← -1;
};
RopeToClass: PROC [rope: ROPE] RETURNS [class: Generic] ~ {
SELECT TRUE FROM
Rope.Equal[rope, "ARRAY"] => class ← array;
Rope.Equal[rope, "PROCEDURE"] => class ← procedure;
Rope.Equal[rope, "SEQUENCE"] => class ← sequence;
Rope.Equal[rope, "BOOLEAN"] => class ← boolean;
Rope.Equal[rope, "CARDINAL"] => class ← cardinal;
Rope.Equal[rope, "LONGCARDINAL"] => class ← longCardinal;
Rope.Equal[rope, "INTEGER"] => class ← integer;
Rope.Equal[rope, "LONGINTEGER"] => class ← longInteger;
Rope.Equal[rope, "STRING"] => class ← string;
Rope.Equal[rope, "UNSPECIFIED"] => class ← unspecified;
Rope.Equal[rope, "ERROR"] => class ← error;
Rope.Equal[rope, "ENUMERATION"] => class ← enumeration;
Rope.Equal[rope, "RECORD"]=> class ← record;
Rope.Equal[rope, "CHOICE"] => class ← choice;
Rope.Equal[rope, "SOURCE"] => class ← bulkDataSource;
Rope.Equal[rope, "SINK"] => class ← bulkDataSink;
ENDCASE => ERROR;
};
RopeTokenToROPE: PUBLIC PROC [r: RopeNode] RETURNS [rope: ROPE] ~ {
quote: ROPE ~ """";
rope ← Rope.Cat[quote, r.text, quote];
};
RopeToVar: PROC [rope: ROPE] RETURNS [var: Variable] ~ {
SELECT TRUE FROM
Rope.Equal[rope, "VARIABLE"] => var ← variable;
Rope.Equal[rope, "CONSTANT"] => var ← constant;
ENDCASE => ERROR;
};
SeeIfArrOrSeq: PUBLIC PROC [first: CType, size: CARD, tables: TABLES] RETURNS [type: CType ← NIL, name: ROPE ← ""] ~ {
successful: BOOLEAN;
value: Value;
IF (first.class # array)
AND (first.class # sequence)
THEN [] ← SendError["Type Mismatch"]
ELSE {
[successful, value] ← HashTable.Fetch[tables.typeTable, first.children.type];
IF (NOT successful) THEN ERROR;
type ← NARROW[value];
IF (first.class = array)
AND (first.bound # size)
THEN [] ← SendError["Wrong No. Of Array Elements in Constant"];
IF (first.class = sequence)
AND (first.bound < size)
THEN [] ← SendError["No. Of Sequence Elements exceeds declared bound in Constant"];
name ← first.children.type;
}
};
VarToRope: PROC [variable: Variable] RETURNS [rope: ROPE] ~ {
SELECT variable FROM
variable => rope ← "VARIABLE";
constant => rope ← "CONSTANT";
ENDCASE => ERROR;
};
}...