<> <> <> DIRECTORY ThreeC4BaseDecl1Def USING[TreeCallFlag, CompareValTypeWithVarType, IdentifierNode, NonNegIntegerNode, RopeNode], ThreeC4CProdAbGramDef USING[IntervalForm], ThreeC4PrimImplDefs USING[BuildErrorType, IsErrorType, EqualTypes, GlobalEnvHandle], ThreeC4Support USING [GetReportStream, GetSourceInfo], Convert USING[IntFromRope], IO USING[int, PutF, PutFR, PutRope, rope, STREAM], ProcessProps USING [GetProp], Rope USING[Cat, Concat, Equal, Fetch, Length, ROPE]; ThreeC4PrimImpl1: CEDAR PROGRAM IMPORTS ThreeC4BaseDecl1Def, Convert, IO, Rope, ThreeC4Support, ThreeC4PrimImplDefs, ProcessProps EXPORTS ThreeC4BaseDecl1Def, ThreeC4CProdAbGramDef, ThreeC4PrimImplDefs = BEGIN OPEN ThreeC4BaseDecl1Def, ThreeC4PrimImplDefs, ThreeC4CProdAbGramDef, ThreeC4Support, ProcessProps; -- some basic stuff IntegerNode: TYPE = REF IntegerNodeBody; IntegerNodeBody: PUBLIC TYPE = RECORD[data: INT, error: BOOLEAN _ FALSE]; IntegerFromRope: PUBLIC PROC[rope: Rope.ROPE] RETURNS[IntegerNode] = {RETURN[NEW[IntegerNodeBody_[Convert.IntFromRope[rope]]]]}; Add1: PUBLIC PROC[arg: IntegerNode] RETURNS[IntegerNode] = {RETURN[IF IsErrorInteger[arg] THEN BuildErrorInteger[] ELSE NEW[IntegerNodeBody_[arg.data+1]]]}; Add1ToInt: PUBLIC PROC[arg: INT] RETURNS[INT] = {RETURN[arg+1]}; Add: PUBLIC PROC[arg1, arg2: IntegerNode] RETURNS[IntegerNode] = {RETURN[IF IsErrorInteger[arg1] OR IsErrorInteger[arg2] THEN BuildErrorInteger[] ELSE 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[IF IsErrorInteger[i1] OR IsErrorInteger[i2] THEN TRUE ELSE 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}; BuildErrorInteger: PUBLIC PROC RETURNS [IntegerNode] = {RETURN [NEW[IntegerNodeBody _ [0, TRUE]]]}; IsErrorInteger: PUBLIC PROC [i: IntegerNode] RETURNS [BOOLEAN] = BEGIN RETURN [i # NIL AND i.error]; END; 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, error: BOOLEAN _ FALSE]; 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]]]]}; BuildErrorName: PUBLIC PROC RETURNS [NameNode] = BEGIN name: NameNode; name _ BuildRopeName["** ERROR **"]; name.error _ TRUE; RETURN [name]; END; IsErrorName: PUBLIC PROC [name: NameNode] RETURNS [BOOLEAN] = BEGIN RETURN [name # NIL AND name.error]; END; 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, error: BOOLEAN _ FALSE]; 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; BuildErrorNameList: PUBLIC PROC RETURNS [NameListNode] = BEGIN RETURN [NEW[NameListNodeBody _ [NIL, NIL, TRUE]]]; END; IsErrorNameList: PUBLIC PROC [list: NameListNode] RETURNS [BOOLEAN] = BEGIN RETURN [list # NIL AND list.error]; END; <> AppendToNameList: PUBLIC PROC[list: NameListNode, name: NameNode] RETURNS[NameListNode] = BEGIN item: NameListItem; IF IsErrorNameList[list] THEN RETURN [BuildErrorNameList[]]; item _ 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; <> <> PrefixToNameList: PUBLIC PROC[name: NameNode, list: NameListNode] RETURNS[NameListNode] = BEGIN item: NameListItem; IF IsErrorNameList[list] THEN RETURN [BuildErrorNameList[]]; item _ 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; <> ConcatNameLists: PUBLIC PROC[list1: NameListNode, list2: NameListNode] RETURNS[NameListNode] = BEGIN IF IsErrorNameList[list1] OR IsErrorNameList[list2] THEN RETURN [BuildErrorNameList[]]; 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; IF IsErrorInteger[nTemps] OR IsErrorInteger[firstTempX] THEN RETURN [BuildErrorNameList[], BuildErrorInteger[]]; nextX _ 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 IsErrorNameList[nameList] THEN BEGIN IO.PutRope[on, "** ERROR **"]; RETURN; END; 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 IsErrorNameList[nameList1] OR IsErrorNameList[nameList2] THEN RETURN [TRUE]; 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 RETURN [FALSE]; 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 RETURN [FALSE]; IF I1 = NIL AND I2 = NIL THEN RETURN[TRUE]; IF I1 = NIL OR I2 = NIL THEN RETURN [FALSE]; ENDLOOP; END; <> PartitionFirstName: PUBLIC PROC[list: NameListNode] RETURNS[NameNode, NameListNode] = BEGIN IF IsErrorNameList[list] THEN RETURN [BuildErrorName[], BuildErrorNameList[]]; IF list = NIL OR list.first = NIL THEN BEGIN PrintError["list lengths do not match"]; RETURN [BuildErrorName[], BuildErrorNameList[]]; END; IF list.first # list.last THEN RETURN[list.first.name, NEW[NameListNodeBody_[list.first.next, list.last]]] ELSE RETURN[list.first.name, NIL]; END; <> PartitionNames: PUBLIC PROC[n: IntegerNode, list: NameListNode] RETURNS[NameListNode, NameListNode] = BEGIN count: INT; IF IsErrorInteger[n] OR IsErrorNameList[list] THEN RETURN [BuildErrorNameList[], BuildErrorNameList[]]; count _ GetIntegerData[n]; IF count = 0 THEN RETURN[NIL, list]; IF list = NIL OR list.first = NIL THEN BEGIN PrintError["list lengths do not match"]; RETURN[BuildErrorNameList[], BuildErrorNameList[]]; END; 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 ELSE IF item = list.last THEN BEGIN PrintError["list lengths do not match"]; RETURN[BuildErrorNameList[], BuildErrorNameList[]]; END; ENDLOOP; END; TheOneName: PUBLIC PROC[list: NameListNode] RETURNS[NameNode] = BEGIN IF IsErrorNameList[list] THEN RETURN [BuildErrorName[]]; IF list.first # list.last THEN {PrintError["expected singleton name list"]; RETURN [BuildErrorName[]]}; RETURN[list.first.name] END; TestEmptyNameList: PUBLIC PROC[list: NameListNode] RETURNS[BOOLEAN] = BEGIN IF IsErrorNameList[list] THEN RETURN [TRUE]; IF list = NIL THEN RETURN[TRUE]; RETURN[list.first = NIL]; END; GenNames: PUBLIC PROC[names: NameListNode, for: PROC[NameNode]] = BEGIN IF IsErrorNameList[names] THEN RETURN; 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]; BuildType: PUBLIC PROC[info: REF ANY] RETURNS[TypeNode] = {RETURN[NEW[TypeNodeBody_[info]]]}; GetTypeInfo: PUBLIC PROC[type: TypeNode] RETURNS[REF ANY] = {RETURN[type.typeInfo]}; -- TypeList TypeListNode: TYPE = REF TypeListNodeBody; TypeListNodeBody: PUBLIC TYPE = RECORD[ first: TypeListItem, last: TypeListItem, error: BOOLEAN _ FALSE]; 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; BuildErrorTypeList: PUBLIC PROC RETURNS [TypeListNode] = BEGIN RETURN [NEW[TypeListNodeBody _ [NIL, NIL, TRUE]]]; END; IsErrorTypeList: PUBLIC PROC [list: TypeListNode] RETURNS [BOOLEAN] = BEGIN RETURN [list # NIL AND list.error]; END; <> AppendToTypeList: PUBLIC PROC[list: TypeListNode, type: TypeNode] RETURNS[TypeListNode] = BEGIN item: TypeListItem; IF IsErrorTypeList[list] THEN RETURN [BuildErrorTypeList[]]; item _ 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; <> <> PrefixToTypeList: PUBLIC PROC[type: TypeNode, list: TypeListNode] RETURNS[TypeListNode] = BEGIN item: TypeListItem; IF IsErrorTypeList[list] THEN RETURN [BuildErrorTypeList[]]; item _ 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; <> ConcatTypeLists: PUBLIC PROC[list1: TypeListNode, list2: TypeListNode] RETURNS[TypeListNode] = BEGIN IF IsErrorTypeList[list1] OR IsErrorTypeList[list2] THEN RETURN [BuildErrorTypeList[]]; 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 IsErrorTypeList[typeList] THEN RETURN [BuildErrorType[]]; IF typeList = NIL OR typeList.first # typeList.last THEN BEGIN PrintError["expected a singleton list"]; RETURN [BuildErrorType[]]; END; RETURN[typeList.first.type]; END; <> PartitionLastType: PUBLIC PROC[typeList: TypeListNode] RETURNS[TypeListNode, TypeNode] = BEGIN IF IsErrorTypeList[typeList] THEN RETURN [BuildErrorTypeList[], BuildErrorType[]]; IF typeList = NIL THEN BEGIN PrintError["list lengths do not match"]; RETURN [BuildErrorTypeList[], BuildErrorType[]]; END; 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; <> PartitionFirstType: PUBLIC PROC[typeList: TypeListNode] RETURNS[TypeNode, TypeListNode] = BEGIN IF IsErrorTypeList[typeList] THEN RETURN [BuildErrorType[], BuildErrorTypeList[]]; IF typeList = NIL OR typeList.first = NIL THEN BEGIN PrintError["list lengths do not match"]; RETURN [BuildErrorType[], BuildErrorTypeList[]]; END; 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 IsErrorTypeList[typeList] THEN RETURN [BuildErrorInteger[]]; 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 t1: TypeListItem; t2: TypeListItem; IF IsErrorTypeList[list1] OR IsErrorTypeList[list2] THEN RETURN [TRUE]; t1 _ list1.first; t2 _ list2.first; WHILE t1 # NIL AND t2 # NIL DO IF NOT EqualTypes[t1.type, t2.type] THEN GOTO oops; IF t1 = list1.last AND t2 # list2.last THEN GOTO oops; IF t1 # list1.last AND t2 = list2.last THEN GOTO oops; IF t1 = list1.last THEN EXIT; t1 _ t1.next; t2 _ t2.next; ENDLOOP; IF t1 = NIL AND t2 # NIL THEN GOTO oops; IF t1 # NIL AND t2 = NIL THEN GOTO oops; RETURN[TRUE]; EXITS oops => {PrintError["type lists do not match"]; RETURN [FALSE]}; END; CompareValTypesWithVarTypes: PUBLIC PROC[valTypes: TypeListNode, varTypes: TypeListNode] RETURNS[BOOLEAN] = BEGIN val: TypeListItem; var: TypeListItem; IF IsErrorTypeList[valTypes] OR IsErrorTypeList[varTypes] THEN RETURN [TRUE]; 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 RETURN [FALSE]; IF val = valTypes.last AND var # varTypes.last THEN {PrintError["too few arguments"]; RETURN [FALSE]}; IF val # valTypes.last AND var = varTypes.last THEN {PrintError["too many arguments"]; RETURN [FALSE]}; IF val = valTypes.last THEN EXIT; val _ val.next; var _ var.next; ENDLOOP; IF val = NIL AND var # NIL THEN {PrintError["too few arguments"]; RETURN [FALSE]}; IF val # NIL AND var = NIL THEN {PrintError["too many arguments"]; RETURN [FALSE]}; RETURN [TRUE]; END; GetFirstType: PUBLIC PROC[list: TypeListNode] RETURNS[TypeNode] = BEGIN IF IsErrorTypeList[list] THEN RETURN [BuildErrorType[]]; IF list = NIL OR list.first = NIL THEN BEGIN PrintError["list lengths do not match"]; RETURN [BuildErrorType[]]; END; RETURN[list.first.type] END; <> <> CopyTypeList: PUBLIC PROC[list: TypeListNode] RETURNS[TypeListNode] = BEGIN newList: TypeListNode; IF IsErrorTypeList[list] THEN RETURN [BuildErrorTypeList[]]; 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 IsErrorTypeList[list] THEN RETURN; IF list = NIL OR list.first = NIL THEN RETURN; FOR item: TypeListItem _ list.first, item.next DO IF NOT IsErrorType[item.type] THEN 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 IsErrorNameList[names] THEN RETURN; IF IsErrorTypeList[types] THEN BEGIN nameItem _ IF names = NIL THEN NIL ELSE names.first; WHILE nameItem # NIL DO IF NOT IsErrorName[nameItem.name] THEN for[nameItem.name, BuildErrorType[]]; nameItem _ IF nameItem = names.last THEN NIL ELSE nameItem.next; ENDLOOP; RETURN; END; nameItem _ IF names = NIL THEN NIL ELSE names.first; typeItem _ IF types = NIL THEN NIL ELSE types.first; WHILE nameItem # NIL AND typeItem # NIL DO IF NOT IsErrorName[nameItem.name] THEN for[nameItem.name, typeItem.type]; nameItem _ IF nameItem = names.last THEN NIL ELSE nameItem.next; typeItem _ IF typeItem = types.last THEN NIL ELSE typeItem.next; ENDLOOP; IF nameItem # NIL THEN BEGIN PrintError["list lengths do not match -- too many names"]; WHILE nameItem # NIL DO IF NOT IsErrorName[nameItem.name] THEN for[nameItem.name, BuildErrorType[]]; nameItem _ IF nameItem = names.last THEN NIL ELSE nameItem.next; ENDLOOP; END; IF typeItem # NIL THEN PrintError["list lengths do not match -- too few names"]; END; PrintError: PUBLIC PROC[m1, m2, m3, m4, m5: Rope.ROPE _ NIL] = BEGIN msg: Rope.ROPE; pos, len: INT; globalEnv: GlobalEnvHandle; msg _ Rope.Cat[m1, m2, m3, m4, m5]; [pos, len] _ SIGNAL ThreeC4Support.GetSourceInfo; IO.PutF[SIGNAL ThreeC4Support.GetReportStream, "\N[%g..%g] %g\N", IO.int[pos], IO.int[pos+len-1], IO.rope[msg]]; globalEnv _ GetGlobalEnv[]; globalEnv.errorCount _ globalEnv.errorCount + 1; END; UnrecoveredError: PUBLIC ERROR = CODE; PrintBadName: PUBLIC PROC[name: NameNode, m1, m2, m3, m4, m5: Rope.ROPE _ NIL] = BEGIN msg: Rope.ROPE; s: IO.STREAM; pos, len: INT; globalEnv: GlobalEnvHandle; msg _ Rope.Cat[m1, m2, m3, m4, m5]; s _ SIGNAL ThreeC4Support.GetReportStream; IO.PutF[s, "\N%g ", IO.rope[name.text]]; [pos, len] _ SIGNAL ThreeC4Support.GetSourceInfo; IO.PutF[s, "[%g..%g]", IO.int[pos], IO.int[pos+len-1]]; IF name.id1 # NIL THEN IO.PutF[s, "[%g]", IO.int[name.id1.position]]; IO.PutF[s, " %g\N", IO.rope[msg]]; globalEnv _ GetGlobalEnv[]; globalEnv.errorCount _ globalEnv.errorCount + 1; END; GetGlobalEnv: PUBLIC PROC RETURNS [GlobalEnvHandle] = BEGIN globalEnv: GlobalEnvHandle; globalEnv _ NARROW[GetProp[$ThreeCasabaFourGlobalEnv]]; IF globalEnv = NIL THEN ERROR; RETURN [globalEnv]; END; END..