ThreeC4PrimImpl1.mesa: October 18, 1985 9:25:36 am PDT
Sturgis, May 7, 1986 6:20:43 pm PDT
DIRECTORY
ThreeC4BaseDecl1Def USING[TreeCallFlag, CompareValTypeWithVarType, IdentifierNode, NonNegIntegerNode, RopeNode],
ThreeC4CProdAbGramDef USING[IntervalForm],
ThreeC4PrimImplDefs USING[],
Convert USING[IntFromRope],
IO USING[int, PutF, PutFR, PutRope, rope, STREAM],
Rope USING[Cat, Concat, Equal, Fetch, Length, ROPE];
ThreeC4PrimImpl1: CEDAR PROGRAM IMPORTS ThreeC4BaseDecl1Def, Convert, IO, Rope EXPORTS ThreeC4BaseDecl1Def, ThreeC4CProdAbGramDef, ThreeC4PrimImplDefs =
BEGIN OPEN ThreeC4BaseDecl1Def, ThreeC4CProdAbGramDef;
-- some basic stuff
IntegerNode: TYPE = REF IntegerNodeBody;
IntegerNodeBody: PUBLIC TYPE = RECORD[data: INT];
IntegerFromRope: PUBLIC PROC[rope: Rope.ROPE] RETURNS[IntegerNode] =
{RETURN[NEW[IntegerNodeBody←[Convert.IntFromRope[rope]]]]};
Add1: PUBLIC PROC[arg: IntegerNode] RETURNS[IntegerNode] =
{RETURN[NEW[IntegerNodeBody←[arg.data+1]]]};
Add1ToInt: PUBLIC PROC[arg: INT] RETURNS[INT] = {RETURN[arg+1]};
Add: PUBLIC PROC[arg1, arg2: IntegerNode] RETURNS[IntegerNode] =
{RETURN[NEW[IntegerNodeBody←[arg1.data+arg2.data]]]};
FakeCopyInt: PUBLIC PROC[arg: INT] RETURNS[INT] = {RETURN[arg]};
EqualTreeCallFlags: PUBLIC PROC[f1, f2: TreeCallFlag] RETURNS[BOOLEAN] =
{RETURN[f1 = f2]};
AndLogical: PUBLIC PROC[b1, b2: BOOLEAN] RETURNS[BOOLEAN] =
{RETURN[b1 AND b2]};
Or: PUBLIC PROC[b1, b2: BOOLEAN] RETURNS[BOOLEAN] =
{RETURN[b1 OR b2]};
FakeCopyInteger: PUBLIC PROC[i1: IntegerNode] RETURNS[IntegerNode] =
{RETURN[i1]};
EqualInteger: PUBLIC PROC[i1, i2: IntegerNode] RETURNS[BOOLEAN] =
{RETURN[i1.data = i2.data]};
RopeFromRopeNode: PUBLIC PROC[r: RopeNode] RETURNS[Rope.ROPE] =
{RETURN[r.text]};
RopeFromNonNegIntegerNode: PUBLIC PROC[n: NonNegIntegerNode] RETURNS[Rope.ROPE] =
{RETURN[n.text]};
RopeFromIdentifierNode: PUBLIC PROC[id: IdentifierNode] RETURNS[Rope.ROPE] =
{RETURN[id.text]};
ConcatRopes2: PUBLIC PROC[r1, r2: Rope.ROPE] RETURNS[Rope.ROPE] =
{RETURN[Rope.Concat[r1, r2]]};
EqualRopes: PUBLIC PROC[r1, r2: Rope.ROPE] RETURNS[BOOLEAN] =
{RETURN[Rope.Equal[r1, r2]]};
GetIntegerData: PUBLIC PROC[i: IntegerNode] RETURNS[INT] =
{RETURN[i.data]};
BuildInteger: PUBLIC PROC[i: INT] RETURNS[IntegerNode] =
{RETURN[NEW[IntegerNodeBody←[i]]]};
AddOneToInt: PUBLIC PROC[i: INT] RETURNS[INT] =
{RETURN[i+1]};
Check: PUBLIC PROC[b: BOOLEAN] RETURNS[BOOLEAN] =
{IF b THEN RETURN[TRUE] ELSE ERROR};
EqualIntervalForm: PUBLIC PROC[f1, f2: IntervalForm] RETURNS[BOOLEAN] =
{RETURN[f1=f2]};
-- Name stuff
NameNode: TYPE = REF NameNodeBody;
NameNodeBody: PUBLIC TYPE = RECORD[
id1: IdentifierNode,
id2: IdentifierNode,
text: Rope.ROPE,
codeText: Rope.ROPE,
key: INT,
next: NameNode];
BuildName: PUBLIC PROC[id: IdentifierNode] RETURNS[NameNode] =
{RETURN[NEW[NameNodeBody←[id, NIL, id.text, id.text, ComputeHashKey[id.text]]]]};
BuildName2: PUBLIC PROC[id1: IdentifierNode, id2: IdentifierNode] RETURNS[NameNode] =
BEGIN
text: Rope.ROPE ← Rope.Cat[id1.text, ".", id2.text];
codeText: Rope.ROPE ← Rope.Cat[id1.text, id2.text];
RETURN[NEW[NameNodeBody←[id1, id2, text, codeText, ComputeHashKey[text]]]];
END;
BuildRopeName: PUBLIC PROC[text: Rope.ROPE] RETURNS[NameNode] =
{RETURN[NEW[NameNodeBody←[NIL, NIL, text, text, ComputeHashKey[text]]]]};
ComputeHashKey: PROC[text: Rope.ROPE] RETURNS[INT] =
BEGIN
key: INT ← 0;
FOR x: INT IN [0..Rope.Length[text]) DO
key ← key + (x+1)*LOOPHOLE[Rope.Fetch[text, x]]
ENDLOOP;
RETURN[key]
END;
ShowName: PUBLIC PROC[name: NameNode, on: IO.STREAM] =
{IO.PutF[on, "%g (%g)", IO.rope[name.text], IO.int[name.key]]};
ShowNamePosition: PUBLIC PROC[name: NameNode, on: IO.STREAM] =
{IF name.id1 # NIL THEN IO.PutF[on, "[%g]", IO.int[name.id1.position]]};
PutNameR: PUBLIC PROC[name: NameNode] RETURNS[Rope.ROPE] =
BEGIN
RETURN[Rope.Concat[
IO.PutFR["%g (%g)", IO.rope[name.text], IO.int[name.key]],
IF name.id1 # NIL THEN IO.PutFR["[%g]", IO.int[name.id1.position]] ELSE NIL]];
END;
GetNameCodeText: PUBLIC PROC[name: NameNode] RETURNS[Rope.ROPE] =
{RETURN[name.codeText]};
GetNameInfo: PUBLIC PROC[name: NameNode] RETURNS[text: Rope.ROPE, key: INT] =
{RETURN[name.text, name.key]};
GetNameIds: PUBLIC PROC[name: NameNode] RETURNS[id1, id2: IdentifierNode] =
{RETURN[name.id1, name.id2]};
EqualNames: PUBLIC PROC[name1, name2: NameNode] RETURNS[BOOLEAN] =
BEGIN
IF name1.key # name2.key THEN RETURN[FALSE];
RETURN[Rope.Equal[name1.text, name2.text]];
END;
-- NameList stuff
NameListNode: TYPE = REF NameListNodeBody;
NameListNodeBody: PUBLIC TYPE = RECORD[
first: NameListItem,
last: NameListItem];
NameListItem: TYPE = REF NameListItemBody;
NameListItemBody: TYPE = RECORD[
name: NameNode,
next: NameListItem];
BuildEmptyNameList: PUBLIC PROC RETURNS[NameListNode] = {RETURN[NIL]};
FakeCopyNameList: PUBLIC PROC[names: NameListNode] RETURNS[NameListNode] =
{RETURN[names]};
BuildOneNameList: PUBLIC PROC[name: NameNode] RETURNS[NameListNode] =
BEGIN
item: NameListItem ← NEW[NameListItemBody←[name, NIL]];
RETURN[NEW[NameListNodeBody←[item, item]]];
END;
damages list argument
AppendToNameList: PUBLIC PROC[list: NameListNode, name: NameNode] RETURNS[NameListNode] =
BEGIN
item: NameListItem ← NEW[NameListItemBody←[name, NIL]];
IF list = NIL THEN RETURN[NEW[NameListNodeBody←[item, item]]];
IF list.last.next # NIL THEN ERROR;
list.last.next ← item;
list.last ← item;
RETURN[list];
END;
shares name argument with result
shares list argument with result
PrefixToNameList: PUBLIC PROC[name: NameNode, list: NameListNode] RETURNS[NameListNode] =
BEGIN
item: NameListItem ← NEW[NameListItemBody←[name, NIL]];
IF list = NIL THEN RETURN[NEW[NameListNodeBody←[item, item]]];
IF list.last.next # NIL THEN ERROR;
item.next ← list.first;
list.first ← item;
RETURN[list];
END;
damages first list argument, shares second with result
ConcatNameLists: PUBLIC PROC[list1: NameListNode, list2: NameListNode] RETURNS[NameListNode] =
BEGIN
IF list1 = NIL OR list1.first = NIL THEN RETURN[list2];
IF list2 = NIL OR list2.first = NIL THEN RETURN[list1];
IF list1.last.next # NIL THEN ERROR;
list1.last.next ← list2.first;
list1.last ← list2.last;
RETURN[list1];
END;
InventTemps: PUBLIC PROC[nTemps: IntegerNode, firstTempX: IntegerNode] RETURNS[names: NameListNode, nextTempX: IntegerNode] =
BEGIN
nextX: INT ← GetIntegerData[firstTempX];
IF GetIntegerData[nTemps] = 0 THEN RETURN[NIL, firstTempX];
names ← NEW[NameListNodeBody←[NIL, NIL]];
FOR I: INT IN [0..GetIntegerData[nTemps]) DO
nameItem: NameListItem ← NEW[NameListItemBody←[BuildRopeName[IO.PutFR["temp%g", IO.int[nextX]]], NIL]];
nextX ← nextX + 1;
IF names.last = NIL THEN names.first ← nameItem ELSE names.last.next ← nameItem;
names.last ← nameItem;
ENDLOOP;
nextTempX ← BuildInteger[nextX];
END;
ShowNameList: PUBLIC PROC[nameList: NameListNode, on: IO.STREAM] =
BEGIN
IF nameList = NIL THEN RETURN;
ShowName[nameList.first.name, on];
FOR item: NameListItem ← nameList.first.next, item.next WHILE item # NIL DO
IO.PutRope[on, ", "];
ShowName[item.name, on];
IF item = nameList.last THEN EXIT;
ENDLOOP;
END;
CompareNameLists: PUBLIC PROC[nameList1, nameList2: NameListNode] RETURNS[BOOLEAN] =
BEGIN
I1: NameListItem;
I2: NameListItem;
IF nameList1 = NIL AND nameList2 = NIL THEN RETURN[TRUE];
IF nameList1.first = NIL AND nameList2.first = NIL THEN RETURN[TRUE];
I1 ← nameList1.first;
I2 ← nameList2.first;
DO
IF NOT Rope.Equal[I1.name.text, I2.name.text] THEN ERROR;
I1 ← I1.next;
I2 ← I2.next;
IF I1 = nameList1.last AND I2 = nameList2.last THEN RETURN[TRUE];
IF I1 = nameList1.last OR I2 = nameList2.last THEN ERROR;
IF I1 = NIL AND I2 = NIL THEN RETURN[TRUE];
IF I1 = NIL OR I2 = NIL THEN ERROR;
ENDLOOP;
END;
incomming list is shared with outgoing list
PartitionFirstName: PUBLIC PROC[list: NameListNode] RETURNS[NameNode, NameListNode] =
BEGIN
IF list.first # list.last THEN
RETURN[list.first.name, NEW[NameListNodeBody←[list.first.next, list.last]]]
ELSE RETURN[list.first.name, NIL];
END;
the incomming list is shared with both results
PartitionNames: PUBLIC PROC[n: IntegerNode, list: NameListNode] RETURNS[NameListNode, NameListNode] =
BEGIN
count: INT ← GetIntegerData[n];
IF count = 0 THEN RETURN[NIL, list];
IF list = NIL THEN ERROR;
IF list.first = NIL THEN ERROR;
FOR item: NameListItem ← list.first, item.next DO
count ← count - 1;
IF count = 0 THEN
BEGIN
IF item = list.last THEN RETURN[list, NIL];
RETURN[NEW[NameListNodeBody←[list.first, item]], NEW[NameListNodeBody←[item.next, list.last]]];
END;
ENDLOOP;
END;
TheOneName: PUBLIC PROC[list: NameListNode] RETURNS[NameNode] =
BEGIN
IF list.first # list.last THEN ERROR;
RETURN[list.first.name]
END;
TestEmptyNameList: PUBLIC PROC[list: NameListNode] RETURNS[BOOLEAN] =
BEGIN
IF list = NIL THEN RETURN[TRUE];
RETURN[list.first = NIL];
END;
GenNames: PUBLIC PROC[names: NameListNode, for: PROC[NameNode]] =
BEGIN
IF names = NIL OR names.first = NIL THEN RETURN;
FOR nameItem: NameListItem ← names.first, nameItem.next WHILE nameItem # NIL DO
for[nameItem.name];
IF nameItem = names.last THEN RETURN;
ENDLOOP;
END;
-- Type
TypeNode: TYPE = REF TypeNodeBody;
TypeNodeBody: PUBLIC TYPE = RECORD[
typeInfo: REF ANY];
EqualTypes: PUBLIC PROC[t1, t2: TypeNode] RETURNS[BOOLEAN] =
BEGIN
IF t1 = t2 THEN RETURN[TRUE];
IF t1.typeInfo = t2.typeInfo THEN RETURN[TRUE];
RETURN[FALSE];
END;
BuildType: PUBLIC PROC[info: REF ANY] RETURNS[TypeNode] =
{RETURN[NEW[TypeNodeBody←[info]]]};
GetTypeInfo: PUBLIC PROC[type: TypeNode] RETURNS[REF ANY] =
{RETURN[type.typeInfo]};
FoundType: PUBLIC PROC[type: TypeNode] RETURNS[BOOLEAN] =
{RETURN[type # NIL]};
-- TypeList
TypeListNode: TYPE = REF TypeListNodeBody;
TypeListNodeBody: PUBLIC TYPE = RECORD[
first: TypeListItem,
last: TypeListItem];
TypeListItem: TYPE = REF TypeListItemBody;
TypeListItemBody: TYPE = RECORD[
type: TypeNode,
next: TypeListItem];
BuildEmptyTypeList: PUBLIC PROC RETURNS[TypeListNode]= {RETURN[NIL]};
BuildOneTypeList: PUBLIC PROC[type: TypeNode] RETURNS[TypeListNode] =
BEGIN
item: TypeListItem ← NEW[TypeListItemBody←[type, NIL]];
RETURN[NEW[TypeListNodeBody←[item, item]]];
END;
damages list argument
AppendToTypeList: PUBLIC PROC[list: TypeListNode, type: TypeNode] RETURNS[TypeListNode] =
BEGIN
item: TypeListItem ← NEW[TypeListItemBody←[type, NIL]];
IF list = NIL THEN RETURN[NEW[TypeListNodeBody←[item, item]]];
IF list.last.next # NIL THEN ERROR;
list.last.next ← item;
list.last ← item;
RETURN[list];
END;
shares name argument with result
shares list argument with result
PrefixToTypeList: PUBLIC PROC[type: TypeNode, list: TypeListNode] RETURNS[TypeListNode] =
BEGIN
item: TypeListItem ← NEW[TypeListItemBody←[type, NIL]];
IF list = NIL THEN RETURN[NEW[TypeListNodeBody←[item, item]]];
IF list.last.next # NIL THEN ERROR;
item.next ← list.first;
list.first ← item;
RETURN[list];
END;
damages first list argument, shares second with result
ConcatTypeLists: PUBLIC PROC[list1: TypeListNode, list2: TypeListNode] RETURNS[TypeListNode] =
BEGIN
IF list1 = NIL OR list1.first = NIL THEN RETURN[list2];
IF list2 = NIL OR list2.first = NIL THEN RETURN[list1];
IF list1.last.next # NIL THEN ERROR;
list1.last.next ← list2.first;
list1.last ← list2.last;
RETURN[list1];
END;
GetTheOneType: PUBLIC PROC[typeList: TypeListNode] RETURNS[TypeNode] =
BEGIN
IF typeList = NIL THEN ERROR;
IF typeList.first # typeList.last THEN ERROR;
RETURN[typeList.first.type];
END;
shares argument with list result
PartitionLastType: PUBLIC PROC[typeList: TypeListNode] RETURNS[TypeListNode, TypeNode] =
BEGIN
IF typeList = NIL THEN ERROR;
IF typeList.first = typeList.last THEN RETURN[NIL, typeList.first.type];
FOR item: TypeListItem ← typeList.first, item.next WHILE item # NIL DO
IF item.next = typeList.last THEN
RETURN[NEW[TypeListNodeBody←[typeList.first, item]], typeList.last.type]
ENDLOOP;
ERROR;
END;
shares argument with list result
PartitionFirstType: PUBLIC PROC[typeList: TypeListNode] RETURNS[TypeNode, TypeListNode] =
BEGIN
IF typeList = NIL THEN ERROR;
IF typeList.first = typeList.last THEN RETURN[typeList.first.type, NIL];
RETURN[typeList.first.type, NEW[TypeListNodeBody←[typeList.first.next, typeList.last]]]
END;
CountTypes: PUBLIC PROC[typeList: TypeListNode] RETURNS[IntegerNode] =
BEGIN
nTypes: INT ← 0;
IF typeList # NIL AND typeList.first # NIL THEN
FOR t: TypeListItem ← typeList.first, t.next DO
nTypes ← nTypes+1;
IF t = typeList.last THEN EXIT;
ENDLOOP;
RETURN[BuildInteger[nTypes]];
END;
CheckForEqualTypeLists: PUBLIC PROC[list1, list2: TypeListNode] RETURNS[BOOLEAN] =
BEGIN
flag: BOOLEAN ← TRUE;
t1: TypeListItem ← list1.first;
t2: TypeListItem ← list2.first;
WHILE t1 # NIL AND t2 # NIL DO
IF NOT EqualTypes[t1.type, t2.type] THEN flag ← FALSE;
IF t1 = list1.last AND t2 # list2.last THEN ERROR;
IF t1 # list1.last AND t2 = list2.last THEN ERROR;
IF t1 = list1.last THEN EXIT;
t1 ← t1.next; t2 ← t2.next;
ENDLOOP;
IF t1 = NIL AND t2 # NIL THEN ERROR;
IF t1 # NIL AND t2 = NIL THEN ERROR;
RETURN[flag];
END;
CompareValTypesWithVarTypes: PUBLIC PROC[valTypes: TypeListNode, varTypes: TypeListNode] RETURNS[BOOLEAN] =
BEGIN
flag: BOOLEAN ← TRUE;
val: TypeListItem;
var: TypeListItem;
IF valTypes = NIL AND varTypes = NIL THEN RETURN[TRUE];
val ← valTypes.first;
var ← varTypes.first;
WHILE val # NIL AND var # NIL DO
IF NOT CompareValTypeWithVarType[val.type, var.type] THEN flag ← FALSE;
IF val = valTypes.last AND var # varTypes.last THEN ERROR;
IF val # valTypes.last AND var = varTypes.last THEN ERROR;
IF val = valTypes.last THEN EXIT;
val ← val.next; var ← var.next;
ENDLOOP;
IF val = NIL AND var # NIL THEN ERROR;
IF val # NIL AND var = NIL THEN ERROR;
RETURN[flag];
END;
GetFirstType: PUBLIC PROC[list: TypeListNode] RETURNS[TypeNode] =
BEGIN
IF list = NIL THEN ERROR;
IF list.first = NIL THEN ERROR;
RETURN[list.first.type]
END;
This procdure is used by lookup routines, so that certain results do not share with a context. I think there is an alternative implementation that delays the copy until absolutely needed. This involves a modified type list representation that includes a "do not modify" bit, and one level of indirection. If some procedure attempts to modify such a representation, it instantly copies it, producing a representation without that bit on, to use as input to the modify. I believe that would justify any routine that would like to claim its result is not shared with its arguments, to simply set the "do not modify" bit on.
For now, I will do a direct copy. September 16, 1985 4:09:29 pm PDT
CopyTypeList: PUBLIC PROC[list: TypeListNode] RETURNS[TypeListNode] =
BEGIN
newList: TypeListNode;
IF list = NIL OR list.first = NIL THEN RETURN[NIL];
newList ← NEW[TypeListNodeBody←[NIL, NIL]];
FOR item: TypeListItem ← list.first, item.next DO
newItem: TypeListItem;
IF item = NIL THEN ERROR;
newItem ← NEW[TypeListItemBody ← [item.type, NIL]];
IF newList.last # NIL THEN newList.last.next ← newItem ELSE newList.first ← newItem;
newList.last ← newItem;
IF item = list.last THEN RETURN[newList];
ENDLOOP;
END;
GenTypeList: PUBLIC PROC[list: TypeListNode, for: PROC[TypeNode]] =
BEGIN
IF list = NIL OR list.first = NIL THEN RETURN;
FOR item: TypeListItem ← list.first, item.next DO
for[item.type];
IF item = list.last THEN EXIT;
ENDLOOP;
END;
GenNameTypePairs: PUBLIC PROC[names: NameListNode, types: TypeListNode, for: PROC[NameNode, TypeNode]] =
BEGIN
nameItem: NameListItem;
typeItem: TypeListItem;
IF names = NIL AND types = NIL THEN RETURN;
nameItem ← names.first;
typeItem ← types.first;
IF nameItem # NIL THEN DO
IF typeItem = NIL THEN ERROR;
for[nameItem.name, typeItem.type];
IF nameItem = names.last THEN EXIT;
IF nameItem.next = NIL THEN ERROR;
IF typeItem = types.last THEN ERROR;
IF typeItem.next = NIL THEN ERROR;
nameItem ← nameItem.next;
typeItem ← typeItem.next;
ENDLOOP;
IF typeItem # types.last THEN ERROR;
END;
END..