
<<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..