<> <> <> DIRECTORY IO USING[int, PutF, PutRope, rope, STREAM], Rope USING[Cat, Equal, ROPE], SaffronATDef USING[ExpNode, ScopeNode], SaffronBaseDef USING[], SaffronGenericDef USING[IdNode, IdNodeBody], SaffronContext USING[]; SaffronContextImpl: CEDAR PROGRAM IMPORTS IO, Rope EXPORTS SaffronATDef, SaffronBaseDef, SaffronContext = BEGIN OPEN SaffronGenericDef, SaffronATDef; LocalContextNode: TYPE = REF LocalContextNodeBody; LocalContextNodeBody: PUBLIC TYPE = RECORD[ frozen: BOOLEAN _ FALSE, rib: ContextRibNode, lvtn: VisibleNames, maxTGNodeIndex: INT _ 0, bottom, top: TypeGraphNodeNode _ NIL, paintIndex: INT _ 0, unpaintedPaint: PaintNode _ NIL, tgNodes: TypeGraphNodeNode _ NIL, fieldLists: FrozenFieldListNode _ NIL]; TypeGraphNodeNode: TYPE = REF TypeGraphNodeNodeBody; TypeGraphNodeNodeBody: PUBLIC TYPE = RECORD[ shown: BOOLEAN, -- used during show routines index: INT, localContext: LocalContextNode, body: REF ANY, -- many different types next: TypeGraphNodeNode -- tgNodes chain from localContext -- ]; CreateBasicLocalContext: PROC RETURNS[LocalContextNode] = BEGIN lc: LocalContextNode _ NEW[LocalContextNodeBody]; lc.lvtn _ CreateEmptyVisibleNames[]; lc.paintIndex _ 0; RETURN[lc]; END; CreateRootLocalContext: PROC RETURNS[LocalContextNode] = BEGIN lc: LocalContextNode _ CreateBasicLocalContext[]; lc.rib _ NIL; [lc.top, lc.bottom] _ CreateTopAndBottom[lc]; lc.unpaintedPaint _ CreateUnpaintedPaint[lc]; InstallBaseTypes[lc]; RETURN[lc]; END; CreateEmptyContext: PUBLIC PROC[rib: ContextRibNode] RETURNS[LocalContextNode] = BEGIN lc: LocalContextNode _ CreateBasicLocalContext[]; lc.rib _ rib; lc.top _ rib.lc.top; lc.bottom _ rib.lc.bottom; lc.unpaintedPaint _ rib.lc.unpaintedPaint; RETURN[lc]; END; FakeDamageContext: PUBLIC PROC[lc: LocalContextNode] RETURNS[lcp: LocalContextNode] = BEGIN lcp _ lc; END; RealShowLocalContext: PROC[on: IO.STREAM, nest: INT, lc: LocalContextNode] = BEGIN FOR tgn: TypeGraphNodeNode _ lc.tgNodes, tgn.next WHILE tgn # NIL DO tgn.shown _ FALSE; ENDLOOP; FOR fl: FrozenFieldListNode _ lc.fieldLists, fl.next WHILE fl # NIL DO fl.shown _ FALSE; ENDLOOP; IO.PutRope[on, "\N\N"]; ShowNested[on, nest]; IO.PutRope[on, "locally visible types\N"]; ShowNested[on, nest+2]; ShowLocallyVisibleTypes[on, nest+2, lc.lvtn]; IO.PutRope[on, "\N\N"]; ShowNested[on, nest]; IO.PutRope[on, "other nodes"]; FOR tgn: TypeGraphNodeNode _ lc.tgNodes, tgn.next WHILE tgn # NIL DO IF NOT tgn.shown THEN BEGIN IO.PutRope[on, "\N\N"]; ShowNested[on, nest+2]; ShowTGN[on, nest+2, tgn]; END ENDLOOP; IO.PutRope[on, "\N\N"]; END; CreateTGN: PROC[lc: LocalContextNode, body: REF ANY] RETURNS[tgn: TypeGraphNodeNode] = BEGIN tgn _ NEW[TypeGraphNodeNodeBody _ [ shown: FALSE, index: lc.maxTGNodeIndex + 1, localContext: lc, body: body, next: lc.tgNodes]]; lc.maxTGNodeIndex _ tgn.index; lc.tgNodes _ tgn; END; <<(FIX: This should be a procedure to be applied to a RIB, we will change as soon as we get ribs)>> FindBottomTGN: PUBLIC PROC[lc: LocalContextNode] RETURNS[tgn: TypeGraphNodeNode] = {RETURN[lc.bottom]}; <<(FIX: This should be a procedure to be applied to a RIB, we will change as soon as we get ribs)>> FindTopTGN: PUBLIC PROC[lc: LocalContextNode] RETURNS[tgn: TypeGraphNodeNode] = {RETURN[lc.top]}; <<(Upon reaching top level context, then looks up names of frames and interfaces, then root context. Must add this later.)>> FindLocallyVisibleTGN: PUBLIC PROC[lc: LocalContextNode, name: IdNode] RETURNS[TypeGraphNodeNode] = BEGIN FOR lcx: LocalContextNode _ lc, lcx.rib.lc WHILE lcx # NIL DO tgn: TypeGraphNodeNode _ NARROW[LookupVisibleName[lcx.lvtn, name].value]; IF tgn # NIL THEN RETURN[tgn]; IF lcx.rib = NIL THEN EXIT; ENDLOOP; ErrorSignal[]; END; <<>> <> ShowLocallyVisibleTypes: PROC[on: IO.STREAM, nest: INT, lvtn: VisibleNames] = BEGIN first: BOOLEAN _ TRUE; ShowOneLVTGN: PROC[name: IdNode, access: AccessValNode, value: REF ANY] = BEGIN IF NOT first THEN {IO.PutRope[on, "\N\N"]; ShowNested[on, nest]}; first _ FALSE; IO.PutRope[on, RopeForId[name]]; ShowAVN[on, nest, access]; IO.PutRope[on, "\N"]; ShowNested[on, nest+2]; ShowNamedTGNTree[on, nest+4, NARROW[value]]; END; IO.PutRope[on, "\N"]; ShowNested[on, nest]; GenVisibleNames[lvtn, ShowOneLVTGN]; END; <<>> <> <> <> <> ShowTGN: PROC[on: IO.STREAM, nest: INT, tgn: TypeGraphNodeNode] = BEGIN IO.PutF[on, "[%g](%g): ", IO.int[tgn.index], IO.int[LOOPHOLE[tgn, INT]]]; IF tgn.shown THEN WITH tgn.body SELECT FROM ntgn: NamedTGN => ShowNamedTGN[on, nest, ntgn, TRUE]; ENDCASE => NULL ELSE BEGIN tgn.shown _ TRUE; WITH tgn.body SELECT FROM ntgn: NamedTGN => ShowNamedTGN[on, nest, ntgn, TRUE]; spctgn: SpecialTGN => ShowSpecialTGN[on, nest, spctgn]; srtgn: SubrangeTGN => ShowSubrangeTGN[on, nest, srtgn]; rn: RecordTGN => ShowRecordTGN[on, nest, rn]; ptgn: PointerTGN => ShowPointerTGN[on, nest, ptgn]; rtgn: RefTGN => ShowRefTGN[on, nest, rtgn]; vtgn: VarTGN => ShowVarTGN[on, nest, vtgn]; rtgn: RelativeTGN => ShowRelativeTGN[on, nest, rtgn]; refenttgn: ReferentTGN => ShowReferentTGN[on, nest, refenttgn]; ltgn: ListTGN => ShowListTGN[on, nest, ltgn]; etgn: EnumTGN => ShowEnumTypeTGN[on, nest, etgn]; vptgn: VariantPartTGN => ShowVariantPartTGN[on, nest, vptgn]; stgn: SequenceTGN => ShowSequenceTGN[on, nest, stgn]; atgn: ArrayTGN => ShowArrayTGN[on, nest, atgn]; dtgn: DescriptorTGN => ShowDescriptorTGN[on, nest, dtgn]; ttgn: TransferTGN => ShowTransferTGN[on, nest, ttgn]; ztgn: ZoneTGN => ShowZoneTGN[on, nest, ztgn]; ltgn: LongTGN => ShowLongTGN[on, nest, ltgn]; stgn: SpecianatedTGN => ShowSpecianatedTGN[on, nest, stgn]; bttgn: BaseTypeTGN => ShowBaseTypeTGN[on, nest, bttgn]; ENDCASE => ERROR; END; END; ShowNamedTGNTree: PROC[on: IO.STREAM, nest: INT, tgn: TypeGraphNodeNode] = BEGIN ntgn: NamedTGN _ NARROW[tgn.body]; ShowNamedTGN[on, nest, ntgn, FALSE]; tgn.shown _ TRUE; END; ShowTGNAsNamedSubstructure: PROC[on: IO.STREAM, nest: INT, name: Rope.ROPE, tgn: TypeGraphNodeNode] = BEGIN IO.PutF[on, "\N"]; ShowNested[on, nest+2]; IO.PutF[on, "%g ", IO.rope[name]]; ShowTGN[on, nest+2, tgn]; END; <<>> <> <<>> <> <<>> BaseTypeTGN: TYPE = REF BaseTypeTGNBody; BaseTypeTGNBody: TYPE = RECORD[typeName: Rope.ROPE]; InstallBaseTypes: PROC[lc: LocalContextNode] = BEGIN -- some subset for now, no additional information InstallBaseType[lc, "ATOM"]; InstallBaseType[lc, "BOOL"]; InstallBaseType[lc, "BOOLEAN"]; InstallBaseType[lc, "CHAR"]; InstallBaseType[lc, "CHARACTER"]; InstallBaseType[lc, "CONDITION"]; InstallBaseType[lc, "MONITORLOCK"]; InstallBaseType[lc, "REAL"]; InstallBaseType[lc, "STRING"]; InstallBaseType[lc, "UNSPECIFIED"]; InstallBaseType[lc, "WORD"]; -- bpw? InstallBaseType[lc, "BYTE"]; -- 8 InstallBaseType[lc, "DINT"]; -- bdpw InstallBaseType[lc, "INT"]; -- bplw InstallBaseType[lc, "INTEGER"]; -- bpw InstallBaseType[lc, "INT16"]; -- 16 InstallBaseType[lc, "INT32"]; -- 32 InstallBaseType[lc, "INT64"]; -- 64 InstallBaseType[lc, "DCARD"]; -- bdpw InstallBaseType[lc, "CARD"]; -- bplw InstallBaseType[lc, "CARDINAL"]; -- bpw InstallBaseType[lc, "CARD16"]; -- 16 InstallBaseType[lc, "CARD32"]; -- 32 InstallBaseType[lc, "CARD64"]; -- 64 InstallBaseType[lc, "NAT"]; -- bpw-1 InstallBaseType[lc, "NATURAL"]; -- bpw-1 InstallBaseType[lc, "NAT15"]; -- 15 InstallBaseType[lc, "NAT31"]; -- 31 InstallBaseType[lc, "NAT63"]; -- 63 END; InstallBaseType: PROC[lc: LocalContextNode, typeName: Rope.ROPE] = BEGIN body: BaseTypeTGN _ NEW[BaseTypeTGNBody _ [typeName: typeName]]; tgn: TypeGraphNodeNode _ CreateTGN[lc, body]; nameAsIdNode: IdNode _ NEW[IdNodeBody _ [typeName, 0, 0]]; RecordVisibleName[lc.lvtn, nameAsIdNode, NIL, tgn]; END; ShowBaseTypeTGN: PROC[on: IO.STREAM, nest: INT, bttgn: BaseTypeTGN] = {IO.PutRope[on, bttgn.typeName]}; <> SpecialKind: TYPE = {bottom, top}; SpecialTGN: TYPE = REF SpecialTGNBody; SpecialTGNBody: TYPE = RECORD[ kind: SpecialKind]; <<>> CreateTopAndBottom: PROC[lc: LocalContextNode] RETURNS[top, bottom: TypeGraphNodeNode] = BEGIN topBody: SpecialTGN _ NEW[SpecialTGNBody _ [top]]; bottomBody: SpecialTGN _ NEW[SpecialTGNBody _ [bottom]]; top _ CreateTGN[lc, topBody]; bottom _ CreateTGN[lc, bottomBody]; END; ShowSpecialTGN: PROC[on: IO.STREAM, nest: INT, spctgn: SpecialTGN] = BEGIN IO.PutF[on, "%g", IO.rope[SELECT spctgn.kind FROM bottom => "bottom", top => "top", ENDCASE => ERROR]]; END; <> NamedTGN: TYPE = REF NamedTGNBody; NamedTGNBody: TYPE = RECORD[ name: IdNode, access: AccessValNode, -- access is initially Nil type: TypeGraphNodeNode, -- type is initially Nil default: DefaultExpNode]; -- default is initially Nil CreateLocallyVisibleTGN: PUBLIC PROC[lc: LocalContextNode, name: IdNode, access: AccessValNode] RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] = BEGIN body: NamedTGN _ NEW[NamedTGNBody _ [name: name]]; tgn _ CreateTGN[lc, body]; RecordVisibleName[lc.lvtn, name, access, tgn]; RETURN[lc, tgn]; END; AddArcFromLVTGNToTGN: PUBLIC PROC[lc: LocalContextNode, lvTgn: TypeGraphNodeNode, access: AccessValNode, tgn: TypeGraphNodeNode, default: DefaultExpNode] RETURNS[lcp: LocalContextNode] = BEGIN namedNode: NamedTGN _ NARROW[lvTgn.body]; namedNode.access _ access; namedNode.type _ tgn; namedNode.default _ default; RETURN[lc]; END; ShowNamedTGN: PROC[on: IO.STREAM, nest: INT, ntgn: NamedTGN, shown: BOOLEAN] = BEGIN IO.PutF[on, "%g ", IO.rope[RopeForId[ntgn.name]]]; ShowAVN[on, nest, ntgn.access]; ShowDEN[on, nest, ntgn.default]; IF NOT shown THEN ShowTGN[on, nest+2, ntgn.type]; END; <> <<>> SubrangeTGN: TYPE = REF SubrangeTGNBody; SubrangeTGNBody: TYPE = RECORD[ subrangeOf: TypeGraphNodeNode, bounds: BoundsValNode]; CreateSubrangeTGN: PUBLIC PROC[lc: LocalContextNode, subrangeOf: TypeGraphNodeNode, bounds: BoundsValNode] RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] = BEGIN body: SubrangeTGN _ NEW[SubrangeTGNBody_[subrangeOf, bounds]]; RETURN[lc, CreateTGN[lc, body]]; END; ShowSubrangeTGN: PROC[on: IO.STREAM, nest: INT, srtgn: SubrangeTGN] = BEGIN IO.PutF[on, " sub range of\N"]; ShowNested[on, nest+2]; ShowTGN[on, nest+2, srtgn.subrangeOf]; IO.PutF[on, "\N"]; ShowNested[on, nest+2]; ShowBVN[on, nest+2, srtgn.bounds]; END; <<>> <<>> <> RecordTGN: TYPE = REF RecordTGNBody; RecordTGNBody: TYPE = RECORD[ paint: PaintNode, machineDependent, monitoredRecord: BOOLEAN, ffl: FrozenFieldListNode]; CreateRecordTGN: PUBLIC PROC[lc: LocalContextNode, p: PaintNode, machineDependent, monitoredRecord: BOOLEAN, ffl: FrozenFieldListNode] RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] = BEGIN body: RecordTGN _ NEW[RecordTGNBody_[p, machineDependent, monitoredRecord, ffl]]; RETURN[lc, CreateTGN[lc, body]]; END; ShowRecordTGN: PROC[on: IO.STREAM, nest: INT, rn: RecordTGN] = BEGIN IO.PutF[on, " RECORD"]; ShowPaint[on, nest, rn.paint]; IF rn.machineDependent THEN IO.PutF[on, " (machineDependent)"]; IF rn.monitoredRecord THEN IO.PutF[on, " (monitoredRecord)"]; ShowFrozenFieldList[on, nest+2, rn.ffl]; END; <> PointerTGN: TYPE = REF PointerTGNBody; PointerTGNBody: TYPE = RECORD[ ordered, base, readOnly: BOOLEAN, bounds: BoundsValNode, target: TypeGraphNodeNode]; RefTGN: TYPE = REF RefTGNBody; RefTGNBody: TYPE = RECORD[ machineDependent: BOOLEAN, target: TypeGraphNodeNode]; VarTGN: TYPE = REF VarTGNBody; VarTGNBody: TYPE = RECORD[ target: TypeGraphNodeNode]; <> RelativeTGN: TYPE = REF RelativeTGNBody; RelativeTGNBody: TYPE = RECORD[ base: TypeGraphNodeNode, pointer: TypeGraphNodeNode]; <<>> <> ReferentTGN: TYPE = REF ReferentTGNBody; ReferentTGNBody: TYPE = RECORD[ contents: TypeGraphNodeNode]; CreatePointerTGN: PUBLIC PROC[lc: LocalContextNode, ordered, base: BOOLEAN, bounds: BoundsValNode, readOnly: BOOLEAN, targetTgn: TypeGraphNodeNode] RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] = BEGIN body: PointerTGN _ NEW[PointerTGNBody_[ordered, base, readOnly, bounds, targetTgn]]; RETURN[lc, CreateTGN[lc, body]]; END; CreateRefTGN: PUBLIC PROC[lc: LocalContextNode, machineDependent: BOOLEAN, contentsTgn: TypeGraphNodeNode] RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] = BEGIN referent: ReferentTGN _ NEW[ReferentTGNBody_[contentsTgn]]; body: RefTGN _ NEW[RefTGNBody_[machineDependent, CreateTGN[lc, referent]]]; RETURN[lc, CreateTGN[lc, body]]; END; CreateVarTGN: PUBLIC PROC[lc: LocalContextNode, targetTgn: TypeGraphNodeNode] RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] = BEGIN body: VarTGN _ NEW[VarTGNBody_[targetTgn]]; RETURN[lc, CreateTGN[lc, body]]; END; CreateRelativeTGN: PUBLIC PROC[lc: LocalContextNode, base, pointer: TypeGraphNodeNode] RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] = BEGIN body: RelativeTGN _ NEW[RelativeTGNBody_[base, pointer]]; RETURN[lc, CreateTGN[lc, body]]; END; ShowPointerTGN: PROC[on: IO.STREAM, nest: INT, ptgn: PointerTGN] = BEGIN IO.PutF[on, "%g Pointer %g %g\N", IO.rope[IF ptgn.ordered THEN "(ordered)" ELSE ""], IO.rope[IF ptgn.base THEN "(base)" ELSE ""], IO.rope[IF ptgn.readOnly THEN "(readOnly)" ELSE ""]]; ShowNested[on, nest+1]; ShowBVN[on, nest+1, ptgn.bounds]; IO.PutF[on, "\N"]; ShowNested[on, nest+1]; IO.PutF[on, "target type = "]; ShowTGN[on, nest+2, ptgn.target]; END; ShowRefTGN: PROC[on: IO.STREAM, nest: INT, rtgn: RefTGN] = BEGIN IO.PutF[on, "Ref %g\N", IO.rope[IF rtgn.machineDependent THEN "(machine dependent)" ELSE ""]]; ShowTGNAsNamedSubstructure[on, nest+2, "target type = ", rtgn.target]; END; ShowVarTGN: PROC[on: IO.STREAM, nest: INT, vtgn: VarTGN] = BEGIN IO.PutF[on, "var\N"]; ShowTGNAsNamedSubstructure[on, nest+2, "target type = ", vtgn.target]; END; ShowRelativeTGN: PROC[on: IO.STREAM, nest: INT, rtgn: RelativeTGN] = BEGIN IO.PutF[on, "relative\N"]; ShowTGNAsNamedSubstructure[on, nest+2, "base type = ", rtgn.base]; ShowTGNAsNamedSubstructure[on, nest+2, "pointer type = ", rtgn.pointer]; END; ShowReferentTGN: PROC[on: IO.STREAM, nest: INT, refenttgn: ReferentTGN] = BEGIN IO.PutF[on, "REFERENT\N"]; ShowTGNAsNamedSubstructure[on, nest+2, "contents type = ", refenttgn.contents]; END; <> <> ListTGN: TYPE = REF ListTGNBody; ListTGNBody: TYPE = RECORD[ readOnly: BOOLEAN, first: TypeGraphNodeNode, rest: ListTGN]; CreateListTGN: PUBLIC PROC[lc: LocalContextNode, readOnly: BOOLEAN, itemType: TypeGraphNodeNode] RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] = BEGIN body: ListTGN _ NEW[ListTGNBody_[readOnly, itemType, NIL]]; body.rest _ body; RETURN[lc, CreateTGN[lc, body]]; END; ShowListTGN: PROC[on: IO.STREAM, nest: INT, ltgn: ListTGN] = BEGIN IO.PutF[on, "LIST %Gof \N", IO.rope[IF ltgn.readOnly THEN "(readOnly)" ELSE ""]]; ShowNested[on, nest+1]; IO.PutF[on, "item type = "]; ShowTGN[on, nest+2, ltgn.first]; END; <> EnumTGN: TYPE = REF EnumTGNBody; EnumTGNBody: TYPE = RECORD[ machineDependent: BOOLEAN, paint: PaintNode, firstElement, lastElement: EnumElementCell]; EnumElementCell: TYPE = REF EnumElementCellBody; EnumElementCellBody: TYPE = RECORD[ id: IdNode, rep: ExpPTreeNode, next: EnumElementCell]; CreateEmptyEnumTypeTGN: PUBLIC PROC[lc: LocalContextNode, machineDependent: BOOLEAN] RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] = BEGIN body: EnumTGN _ NEW[EnumTGNBody_[machineDependent, GetUniquePaint[lc].p, NIL, NIL]]; RETURN[lc, CreateTGN[lc, body]]; END; <<>> <> AppendElementToEnumTypeTGN: PUBLIC PROC[lc: LocalContextNode, tgn: TypeGraphNodeNode, elementName: IdNode, rep: ExpPTreeNode] RETURNS[lcp: LocalContextNode] = BEGIN body: EnumTGN _ NARROW[tgn.body]; cell: EnumElementCell _ NEW[EnumElementCellBody _ [elementName, rep, NIL]]; IF body.lastElement = NIL THEN body.firstElement _ cell ELSE body.lastElement.next _ cell; body.lastElement _ cell; RETURN[lc]; END; ShowEnumTypeTGN: PROC[on: IO.STREAM, nest: INT, etgn: EnumTGN] = BEGIN IO.PutF[on, "Enumerated Type %g {", IO.rope[IF etgn.machineDependent THEN "(MachineDependent)" ELSE ""]]; ShowPaint[on, nest, etgn.paint]; FOR cell: EnumElementCell _ etgn.firstElement, cell.next WHILE cell # NIL DO IO.PutF[on, " %g %g", IF cell.id # NIL THEN IO.rope[RopeForId[cell.id]] ELSE IO.rope[""], IF cell.rep # NIL THEN IO.rope[Rope.Cat["(", TextForExpPTree[cell.rep], ")"]] ELSE IO.rope[""]]; IF cell = etgn.lastElement THEN EXIT; ENDLOOP; IO.PutF[on, " }"]; END; <> FieldNode: TYPE = REF FieldNodeBody; FieldNodeBody: PUBLIC TYPE = RECORD[ name: IdNode, pvn: PositionValNode, avn: AccessValNode, tgn: TypeGraphNodeNode, default: DefaultExpNode]; <<(for unnamed fields, name = NIL)>> FieldListNode: TYPE = REF FieldListNodeBody; FieldListNodeBody: PUBLIC TYPE = RECORD[ any: BOOLEAN, nFields: INT, nCells: INT, firstCell, lastCell: FieldListCell]; FieldListCell: TYPE = REF FieldListCellBody; FieldListCellBody: TYPE = RECORD[ item: REF ANY, next: FieldListCell]; <<(an item is either a Field or a FrozenFieldList)>> FrozenFieldListNode: TYPE = REF FrozenFieldListNodeBody; FrozenFieldListNodeBody: PUBLIC TYPE = RECORD[ shown: BOOLEAN, -- used during show variant: BOOLEAN, -- last field is a variant ffl, or is a variant part TGN any: BOOLEAN, nFields: CARDINAL, next: FrozenFieldListNode, fields: SEQUENCE nSlots: CARDINAL OF FFLSlot]; FFLSlot: TYPE = RECORD[case: FFLCase, name: IdNode, pvn: PositionValNode, avn: AccessValNode, tgn: TypeGraphNodeNode, default: DefaultExpNode, ffl: FrozenFieldListNode]; FFLCase: TYPE = {field, ffl}; CreateNamedField: PUBLIC PROC[n: IdNode, pvn: PositionValNode, avn: AccessValNode, tgn: TypeGraphNodeNode, default: DefaultExpNode] RETURNS[f: FieldNode] = {RETURN[NEW[FieldNodeBody_[n, pvn, avn, tgn, default]]]}; CreateUnnamedField: PUBLIC PROC[tgn: TypeGraphNodeNode, default: DefaultExpNode] RETURNS[f: FieldNode] = {RETURN[NEW[FieldNodeBody_[NIL, NIL, NIL, tgn, default]]]}; CreateEmptyFieldList: PUBLIC PROC RETURNS[fl: FieldListNode] = {RETURN[NEW[FieldListNodeBody_[FALSE, 0, 0, NIL, NIL]]]}; AnyFieldList: PUBLIC PROC RETURNS[fl: FieldListNode] = {RETURN[NEW[FieldListNodeBody_[TRUE, 0, 0, NIL, NIL]]]}; PrependCellToFieldList: PROC[nFields: INT, cell: FieldListCell, fl: FieldListNode] RETURNS[flp: FieldListNode] = BEGIN IF fl.any THEN ERROR; cell.next _ fl.firstCell; fl.firstCell _ cell; IF fl.lastCell = NIL THEN fl.lastCell _ cell; fl.nFields _ fl.nFields + nFields; fl.nCells _ fl.nCells + 1; RETURN[fl]; END; AppendCellToFieldList: PROC[fl: FieldListNode, nFields: INT, cell: FieldListCell] RETURNS[flp: FieldListNode] = BEGIN IF fl.any THEN ERROR; IF fl.lastCell = NIL THEN fl.firstCell _ cell ELSE fl.lastCell.next _ cell; fl.lastCell _ cell; fl.nFields _ fl.nFields + nFields; fl.nCells _ fl.nCells + 1; RETURN[fl]; END; PrependFieldToFieldList: PUBLIC PROC[f: FieldNode, fl: FieldListNode] RETURNS[flp: FieldListNode] = BEGIN cell: FieldListCell _ NEW[FieldListCellBody _ [f, NIL]]; RETURN[PrependCellToFieldList[1, cell, fl]]; END; AppendFieldToFieldList: PUBLIC PROC[fl: FieldListNode, f: FieldNode] RETURNS[flp: FieldListNode] = BEGIN cell: FieldListCell _ NEW[FieldListCellBody _ [f, NIL]]; RETURN[AppendCellToFieldList[fl, 1, cell]]; END; <> <> <> <> <> AppendFFLToFieldList: PUBLIC PROC[fl: FieldListNode, ffl: FrozenFieldListNode] RETURNS[flp: FieldListNode] = BEGIN cell: FieldListCell _ NEW[FieldListCellBody _ [ffl, NIL]]; RETURN[AppendCellToFieldList[fl, ffl.nFields, cell]]; END; <<>> ConcatFieldLists: PUBLIC PROC[fl1, fl2: FieldListNode] RETURNS[fl: FieldListNode] = BEGIN IF fl1.any OR fl2.any THEN ERROR; IF fl1.firstCell = NIL THEN RETURN[fl2]; IF fl2.firstCell = NIL THEN RETURN[fl1]; fl1.lastCell.next _ fl2.firstCell; fl1.lastCell _ fl2.lastCell; fl1.nFields _ fl1.nFields + fl2.nFields; fl1.nCells _ fl1.nCells + fl2.nCells; RETURN[fl1]; END; FreezeFieldList: PUBLIC PROC[lc: LocalContextNode, fl: FieldListNode] RETURNS[lcp: LocalContextNode, ffl: FrozenFieldListNode] = BEGIN cell: FieldListCell _ fl.firstCell; ffl _ NEW[FrozenFieldListNodeBody[fl.nCells]]; ffl.any _ fl.any; ffl.nFields _ fl.nFields; ffl.next _ lc.fieldLists; lc.fieldLists _ ffl; FOR I: CARDINAL IN [0..CARDINAL[fl.nCells]) DO ffl[I] _ WITH cell.item SELECT FROM f: FieldNode => [field, f.name, f.pvn, f.avn, f.tgn, f.default, NIL], fflist: FrozenFieldListNode => [ffl, NIL, NIL, NIL, NIL, NIL, fflist], ENDCASE => ERROR; cell _ cell.next; ENDLOOP; FOR I: CARDINAL IN [0..ffl.nFields) DO SELECT ffl[I].case FROM field => IF IsVariantPartTGN[ffl[I].tgn] THEN BEGIN IF I = (CARDINAL[ffl.nFields]-1) THEN ffl.variant _ TRUE ELSE ERROR; -- variation allowed only in last field END; ffl => IF ffl[I].ffl.variant THEN BEGIN IF I = (CARDINAL[ffl.nFields]-1) THEN ffl.variant _ TRUE ELSE ERROR; -- variation allowed only in last field END; ENDCASE => ERROR; ENDLOOP; RETURN[lc, ffl]; END; ShowFrozenFieldList: PROC[on: IO.STREAM, nest: INT, ffl: FrozenFieldListNode] = BEGIN IO.PutF[on, "ffl (%g) %g", IO.int[LOOPHOLE[ffl, INT]], IO.rope[IF ffl.any THEN "ANY" ELSE ""]]; IF NOT ffl.shown THEN BEGIN ffl.shown _ TRUE; FOR x: CARDINAL IN [0..ffl.nSlots) DO IO.PutRope[on, "\N"]; ShowNested[on, nest]; SELECT ffl.fields[x].case FROM field => BEGIN IF ffl.fields[x].name = NIL THEN BEGIN -- assume unnamed field IO.PutF[on, "<>: "] END ELSE BEGIN -- assume named field IO.PutF[on, "%g: ", IO.rope[RopeForId[ffl.fields[x].name]]]; ShowPVN[on, nest, ffl.fields[x].pvn]; ShowAVN[on, nest, ffl.fields[x].avn]; END; ShowTGN[on, nest+2, ffl.fields[x].tgn]; ShowDEN[on, nest+2, ffl.fields[x].default] END; ffl => ShowFrozenFieldList[on, nest+2, ffl.fields[x].ffl]; ENDCASE => ERROR; ENDLOOP; END; END; <<>> <> VariantPartTGN: TYPE = REF VariantPartTGNBody; VariantPartTGNBody: TYPE = RECORD[ flavor: VariantFlavorNode, tagType: TypeGraphNodeNode, types: FrozenUnionList]; UnionListNode: TYPE = REF UnionListNodeBody; UnionListNodeBody: PUBLIC TYPE = RECORD[ nCells: CARDINAL, first, last: UnionListCell]; UnionListCell: TYPE = REF UnionListCellBody; UnionListCellBody: TYPE = RECORD[id: IdNode, ffl: FrozenFieldListNode, next: UnionListCell]; FrozenUnionList: TYPE = REF FrozenUnionListBody; FrozenUnionListBody: TYPE = RECORD[data: SEQUENCE nTypes: CARDINAL OF FULSlot]; FULSlot: TYPE = RECORD[id: IdNode, ffl: FrozenFieldListNode]; CreateVariantPartTGN: PUBLIC PROC[lc: LocalContextNode, flavor: VariantFlavorNode, tagType: TypeGraphNodeNode, types: UnionListNode] RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] = BEGIN body: VariantPartTGN _ NEW[VariantPartTGNBody_[ flavor, tagType, FreezeUnionList[types]]]; RETURN[lc, CreateTGN[lc, body]]; END; IsVariantPartTGN: PROC[tgn: TypeGraphNodeNode] RETURNS[BOOLEAN] = BEGIN WITH tgn.body SELECT FROM vptgn: VariantPartTGN => RETURN[TRUE]; ENDCASE => RETURN[FALSE]; END; GetVariantPartUnionList: PROC[tgn: TypeGraphNodeNode] RETURNS[FrozenUnionList] = BEGIN WITH tgn.body SELECT FROM vptgn: VariantPartTGN => RETURN[vptgn.types]; ENDCASE => ERROR; END; ShowVariantPartTGN: PROC[on: IO.STREAM, nest: INT, vptgn: VariantPartTGN] = BEGIN IO.PutF[on, "variant\N"]; ShowNested[on, nest+2]; ShowVariantFlavor[on, nest+2, vptgn.flavor]; IO.PutF[on, "tagType\N"]; ShowNested[on, nest+2]; ShowTGN[on, nest+2, vptgn.tagType]; IO.PutF[on, "\N"]; ShowNested[on, nest+2]; IO.PutF[on, "variations\N"]; ShowNested[on, nest+2]; ShowFrozenUnionList[on, nest+2, vptgn.types]; END; CreateEmptyUnionList: PUBLIC PROC RETURNS[UnionListNode] = {RETURN[NEW[UnionListNodeBody_[0, NIL, NIL]]]}; <> AppendToUnionList: PUBLIC PROC[ul: UnionListNode, id: IdNode, ffl: FrozenFieldListNode] RETURNS[ulnp: UnionListNode] = BEGIN newCell: UnionListCell _ NEW[UnionListCellBody _ [id, ffl, NIL]]; IF ul.first = NIL THEN ul.first _ newCell ELSE ul.last.next _ newCell; ul.last _ newCell; ul.nCells _ ul.nCells+1; RETURN[ul]; END; <> FreezeUnionList: PROC[ul: UnionListNode] RETURNS[FrozenUnionList] = BEGIN ful: FrozenUnionList _ NEW[FrozenUnionListBody[ul.nCells]]; cell: UnionListCell _ ul.first; FOR I: CARDINAL IN [0..ful.nTypes) DO ful[I] _ [cell.id, cell.ffl]; cell _ cell.next; ENDLOOP; RETURN[ful] END; ShowFrozenUnionList: PROC[on: IO.STREAM, nest: INT, ful: FrozenUnionList] = BEGIN first: BOOLEAN _ FALSE; FOR I: CARDINAL IN [0..ful.nTypes) DO IF NOT first THEN {IO.PutF[on, "\N"]; ShowNested[on, nest]}; IO.PutF[on, "%g => ", IO.rope[RopeForId[ful[I].id]]]; ShowFrozenFieldList[on, nest+2, ful[I].ffl]; ENDLOOP; END; <<>> <> VariantFlavorNode: TYPE = REF VariantFlavorNodeBody; VariantFlavorNodeBody: PUBLIC TYPE = RECORD[ SELECT flavor: VFlavor FROM overlaid => [], computed => [], vanilla => [ id: IdNode, position: PositionValNode, access: AccessValNode], ENDCASE]; VFlavor: TYPE = {overlaid, computed, vanilla}; OverlaidVariantFlavorConst: PUBLIC PROC RETURNS[VariantFlavorNode] = {RETURN[NEW[overlaid VariantFlavorNodeBody _ [overlaid[]]]]}; ComputedVariantFlavorConst: PUBLIC PROC RETURNS[VariantFlavorNode] = {RETURN[NEW[computed VariantFlavorNodeBody _ [computed[]]]]}; VanillaVariantFlavorVal: PUBLIC PROC[id: IdNode, position: PositionValNode, access: AccessValNode] RETURNS[VariantFlavorNode] = {RETURN[NEW[vanilla VariantFlavorNodeBody _ [vanilla[id, position, access]]]]}; ShowVariantFlavor: PUBLIC PROC[on: IO.STREAM, nest: INT, vf: VariantFlavorNode] = BEGIN WITH vf SELECT FROM o: REF VariantFlavorNodeBody.overlaid => IO.PutF[on, "Overlaid"]; c: REF VariantFlavorNodeBody.computed => IO.PutF[on, "Computed"]; v: REF VariantFlavorNodeBody.vanilla => BEGIN IO.PutF[on, "Vanilla %g", IO.rope[RopeForId[v.id]]]; ShowPVN[on, nest, v.position]; ShowAVN[on, nest, v.access]; END; ENDCASE => ERROR; END; <<>> <> SequenceTGN: TYPE = REF SequenceTGNBody; SequenceTGNBody: PUBLIC TYPE = RECORD[ packed: BOOLEAN, id: IdNode, position: PositionValNode, access: AccessValNode, tagType: TypeGraphNodeNode, type: TypeGraphNodeNode]; CreateSequenceTGN: PUBLIC PROC[lc: LocalContextNode, packed: BOOLEAN, id: IdNode, position: PositionValNode, access: AccessValNode, tagType: TypeGraphNodeNode, type: TypeGraphNodeNode] RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] = BEGIN body: SequenceTGN _ NEW[SequenceTGNBody_[packed, id, position, access, tagType, type]]; RETURN[lc, CreateTGN[lc, body]]; END; ShowSequenceTGN: PROC[on: IO.STREAM, nest: INT, stgn: SequenceTGN] = BEGIN IO.PutF[on, "%gsequence\N", IO.rope[IF stgn.packed THEN "packed " ELSE ""]]; ShowNested[on, nest+2]; IO.PutF[on, "%g", IO.rope[RopeForId[stgn.id]]]; ShowPVN[on, nest, stgn.position]; ShowAVN[on, nest, stgn.access]; ShowTGNAsNamedSubstructure[on, nest+2, "tagType", stgn.tagType]; ShowTGNAsNamedSubstructure[on, nest+2, "type", stgn.type]; IO.PutF[on, "\N"]; ShowNested[on, nest+2]; IO.PutF[on, "tagType "]; END; <> <<>> ArrayTGN: TYPE = REF ArrayTGNBody; ArrayTGNBody: PUBLIC TYPE = RECORD[ packed: BOOLEAN, indexType: TypeGraphNodeNode, itemType: TypeGraphNodeNode]; CreateArrayTGN: PUBLIC PROC[lc: LocalContextNode, packed: BOOLEAN, indexType: TypeGraphNodeNode, itemType: TypeGraphNodeNode] RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] = BEGIN body: ArrayTGN _ NEW[ArrayTGNBody_[packed, indexType, itemType]]; RETURN[lc, CreateTGN[lc, body]]; END; ShowArrayTGN: PROC[on: IO.STREAM, nest: INT, atgn: ArrayTGN] = BEGIN IO.PutF[on, "%array\N", IO.rope[IF atgn.packed THEN "packed " ELSE ""]]; ShowTGNAsNamedSubstructure[on, nest+2, "indexType", atgn.indexType]; ShowTGNAsNamedSubstructure[on, nest+2, "itemType", atgn.itemType]; END; <> <<>> DescriptorTGN: TYPE = REF DescriptorTGNBody; DescriptorTGNBody: PUBLIC TYPE = RECORD[ readonly: BOOLEAN, itemType: TypeGraphNodeNode]; CreateDescriptorTGN: PUBLIC PROC[lc: LocalContextNode, readonly: BOOLEAN, itemType: TypeGraphNodeNode] RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] = BEGIN body: DescriptorTGN _ NEW[DescriptorTGNBody_[readonly, itemType]]; RETURN[lc, CreateTGN[lc, body]]; END; ShowDescriptorTGN: PROC[on: IO.STREAM, nest: INT, dtgn: DescriptorTGN] = BEGIN IO.PutF[on, "%descriptor\N", IO.rope[IF dtgn.readonly THEN "ReadOnly " ELSE ""]]; ShowTGNAsNamedSubstructure[on, nest+2, "itemType", dtgn.itemType]; END; <> <<>> TransferTGN: TYPE = REF TransferTGNBody; TransferTGNBody: PUBLIC TYPE = RECORD[ safe: BOOLEAN, mode: TransferMode, arguments: FrozenFieldListNode, results: FrozenFieldListNode]; TransferMode: TYPE = {proc, port, signal, error, process, program}; CreateTransferTGN: PUBLIC PROC[lc: LocalContextNode, safe: BOOLEAN, modeName: Rope.ROPE, arguments, results: FrozenFieldListNode] RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] = BEGIN mode: TransferMode _ SELECT TRUE FROM Rope.Equal["proc", modeName] => proc, Rope.Equal["port", modeName] => port, Rope.Equal["signal", modeName] => signal, Rope.Equal["error", modeName] => error, Rope.Equal["process", modeName] => process, Rope.Equal["program", modeName] => program, ENDCASE => ERROR; body: TransferTGN _ NEW[TransferTGNBody_[safe, mode, arguments, results]]; RETURN[lc, CreateTGN[lc, body]]; END; ShowTransferTGN: PROC[on: IO.STREAM, nest: INT, ttgn: TransferTGN] = BEGIN modeName: Rope.ROPE _ SELECT ttgn.mode FROM proc => "proc", port => "port", signal => "signal", error => "error", process => "process", program => "program", ENDCASE => ERROR; IO.PutF[on, "% transfer\N", IO.rope[modeName]]; ShowNested[on, nest+2]; ShowFrozenFieldList[on, nest+2, ttgn.arguments]; IO.PutF[on, "\N"]; ShowNested[on, nest+2]; ShowFrozenFieldList[on, nest+2, ttgn.results]; END; <> ZoneTGN: TYPE = REF ZoneTGNBody; ZoneTGNBody: PUBLIC TYPE = RECORD[ uncounted: BOOLEAN]; CreateZoneTGN: PUBLIC PROC[lc: LocalContextNode, uncounted: BOOLEAN] RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] = BEGIN body: ZoneTGN _ NEW[ZoneTGNBody_[uncounted]]; RETURN[lc, CreateTGN[lc, body]]; END; ShowZoneTGN: PROC[on: IO.STREAM, nest: INT, ztgn: ZoneTGN] = BEGIN IO.PutF[on, "% zone ", IO.rope[IF ztgn.uncounted THEN "uncounted" ELSE "counted"]]; END; <> <<(For now we treat this as a constructor, but we could take it as a parameter during the construction of the underlying type)>> <<(In the world of 16bit words, the underlying type must be a 16bit numerical quantity, a 16bit pointer, or an (array) descriptor. LONG makes it into a 32bit quantity. In other worlds, this may be a no-op, or not, depending.)>> LongTGN: TYPE = REF LongTGNBody; LongTGNBody: PUBLIC TYPE = RECORD[ underlyingType: TypeGraphNodeNode]; CreateLongTGN: PUBLIC PROC[lc: LocalContextNode, underlyingType: TypeGraphNodeNode] RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] = BEGIN body: LongTGN _ NEW[LongTGNBody_[underlyingType]]; RETURN[lc, CreateTGN[lc, body]]; END; ShowLongTGN: PROC[on: IO.STREAM, nest: INT, ltgn: LongTGN] = BEGIN IO.PutF[on, "% long "]; ShowTGN[on, nest+2, ltgn.underlyingType]; END; <> InterfaceTGN: TYPE = REF InterfaceTGNBody; InterfaceTGNBody: PUBLIC TYPE = RECORD[ typeNames: VisibleNames]; <<(Initial implementation will use same data structure as local type names)>> <<(these are type graph nodes that occur inside a type graph. They are not the external manifestation of an interface, which is a DefFileInterfaceNode)>> <<>> <> <> <> <> <> <> <> AddTGNToInterfaceTGN: PUBLIC PROC[lc: LocalContextNode, if: TypeGraphNodeNode, id: IdNode, access: AccessValNode, tgn: TypeGraphNodeNode] RETURNS[lcp: LocalContextNode] = BEGIN iftgn: InterfaceTGN _ NARROW[if.body]; RecordVisibleName[iftgn.typeNames, id, access, tgn]; RETURN[lc]; END; LookupTypeNameInInterfaceTGN: PUBLIC PROC[lc: LocalContextNode, id: IdNode, if: TypeGraphNodeNode] RETURNS[access: AccessValNode, tgn: TypeGraphNodeNode] = BEGIN iftgn: InterfaceTGN _ NARROW[if.body]; refAnyTgn: REF ANY; [access, refAnyTgn] _ LookupVisibleName[iftgn.typeNames, id]; RETURN[access, NARROW[refAnyTgn]]; END; GenTypeNamesFromInterface: PROC[if: TypeGraphNodeNode, for: PROC[IdNode, AccessValNode, TypeGraphNodeNode]] = BEGIN iftgn: InterfaceTGN _ NARROW[if.body]; localFor: PROC[name: IdNode, access: AccessValNode, value: REF ANY] = {for[name, access, NARROW[value]]}; GenVisibleNames[iftgn.typeNames, localFor]; END; <<(following two operations correspond to entries in an OPEN clause)>> <<>> <<(OPEN name: interface)>> RenameInterface: PUBLIC PROC[lc: LocalContextNode, name: IdNode, interface: TypeGraphNodeNode] RETURNS[lcp: LocalContextNode] = BEGIN newTGN: TypeGraphNodeNode _ CreateLocallyVisibleTGN[lc, name, AccessValConst["private"]].tgn; WITH interface.body SELECT FROM itgn: InterfaceTGN => NULL; ENDCASE => ERROR; [] _ AddArcFromLVTGNToTGN[lc, newTGN, AccessValConst["private"], interface, DefaultExpVal["", NullExpPTree[]]]; RETURN[lc]; END; <<(OPEN interface)>> OpenInterface: PUBLIC PROC[lc: LocalContextNode, interface: TypeGraphNodeNode] RETURNS[lcp: LocalContextNode] = BEGIN OpenOneInterfaceTypeName: PROC[name: IdNode, access: AccessValNode, tgn: TypeGraphNodeNode] = BEGIN newTGN: TypeGraphNodeNode _ CreateLocallyVisibleTGN[lc, name, AccessValConst["private"]].tgn; <> [] _ AddArcFromLVTGNToTGN[lc, newTGN, AccessValConst["private"], tgn, DefaultExpVal["", NullExpPTree[]]]; END; GenTypeNamesFromInterface[interface, OpenOneInterfaceTypeName]; END; <<>> <<>> <> FrameTGN: TYPE = REF FrameTGNBody; FrameTGNBody: PUBLIC TYPE = RECORD[ FrameTGN: REF ANY]; <<(I will fill this in as needed later)>> FindFrameTGN: PUBLIC PROC[lc: LocalContextNode, id: IdNode] RETURNS[tgn: TypeGraphNodeNode] = BEGIN tgn _ FindLocallyVisibleTGN[lc, id]; WITH tgn.body SELECT FROM ftgn: FrameTGN => RETURN[tgn]; ENDCASE => ERROR; END; <> <<>> <<(we are either : 1) specializing a sequence or array of length 0, 2) discriminating a variant, 3) selecting an interface type.) There is one syntactic case in which we can't tell which until the data structures are completely built. ("foo[red]"), so we use this more general term for now.)>> <<(Dan Swinehart selected the word Specianated, if you can't figure out what this word means, try another field.)>> <<>> <<(underlying type must be a variant style record type, a sequence style record type, an array type with empty index domain, or an interface TGN.)>> <<(In the case of a def file TGN we do the appropriate look up, as this case can be distinguished during this construction pass.)>> <<>> <<(only one of expParameter and idParam will be non nil)>> SpecianatedTGN: TYPE = REF SpecianatedTGNBody; SpecianatedTGNBody: PUBLIC TYPE = RECORD[ expParam: ExpPTreeNode, idParam: IdNode, underlyingType: TypeGraphNodeNode]; <<(This one might be the selection of a type from an interface)>> CreateSpecianatedTGNUsingId: PUBLIC PROC[lc: LocalContextNode, underlyingType: TypeGraphNodeNode, id: IdNode] RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] = BEGIN WITH underlyingType.body SELECT FROM iftgn: InterfaceTGN => BEGIN RETURN[lc, LookupTypeNameInInterfaceTGN[lc, id, underlyingType].tgn]; <> END; ENDCASE => BEGIN body: SpecianatedTGN _ NEW[SpecianatedTGNBody_[NIL, id, underlyingType]]; RETURN[lc, CreateTGN[lc, body]]; END; END; <<(this one can not be the selection of a type from an interface)>> CreateSpecianatedTGNUsingExp: PUBLIC PROC[lc: LocalContextNode, underlyingType: TypeGraphNodeNode, parameter: ExpPTreeNode] RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] = BEGIN body: SpecianatedTGN _ NEW[SpecianatedTGNBody_[parameter, NIL, underlyingType]]; RETURN[lc, CreateTGN[lc, body]]; END; ShowSpecianatedTGN: PROC[on: IO.STREAM, nest: INT, stgn: SpecianatedTGN] = BEGIN IO.PutF[on, "%g specianated ", IF stgn.expParam # NIL THEN IO.rope[TextForExpPTree[stgn.expParam]] ELSE IO.rope[RopeForId[stgn.idParam]]]; ShowTGN[on, nest+2, stgn.underlyingType]; END; <<>> <> PaintNode: TYPE = REF PaintNodeBody; PaintNodeBody: PUBLIC TYPE = RECORD[ parentlc: LocalContextNode, index: INT]; CreateUnpaintedPaint: PROC[lc: LocalContextNode] RETURNS[PaintNode] = {RETURN[NEW[PaintNodeBody_[lc, 0]]]}; GetUnpaintedPaint: PUBLIC PROC[lc: LocalContextNode] RETURNS[lcp: LocalContextNode, p: PaintNode] = {RETURN[lc, lc.unpaintedPaint]}; <<>> GetUniquePaint: PUBLIC PROC[lc: LocalContextNode] RETURNS[lcp: LocalContextNode, p: PaintNode] = BEGIN lc.paintIndex _ lc.paintIndex + 1; RETURN[lc, NEW[PaintNodeBody_[lc, lc.paintIndex]]]; END; ShowPaint: PROC[on: IO.STREAM, nest: INT, paint: PaintNode] = BEGIN IO.PutF[on, " (paint = %g) ", IO.int[paint.index]]; END; <> <> <<>> VisibleNames: TYPE = REF VisibleNamesBody; VisibleNamesBody: TYPE = RECORD[ first: VNCell]; VNCell: TYPE = REF VNCellBody; VNCellBody: TYPE = RECORD[ id: IdNode, access: AccessValNode, value: REF ANY, next: VNCell]; CreateEmptyVisibleNames: PROC RETURNS[vn: VisibleNames] = BEGIN vn _ NEW[VisibleNamesBody _ [NIL]]; RETURN[vn]; END; RecordVisibleName: PROC[vn: VisibleNames, name: IdNode, access: AccessValNode, value: REF ANY] = BEGIN newCell: VNCell _ NEW[VNCellBody_[name, access, value, vn.first]]; IF (LookupVisibleName[vn, name].value # NIL) THEN ErrorSignal[]; newCell _ NEW[VNCellBody_[name, access, value, vn.first]]; vn.first _ newCell; END; LookupVisibleName: PROC[vn: VisibleNames, name: IdNode] RETURNS[access: AccessValNode, value: REF ANY] = BEGIN cell: VNCell _ vn.first; WHILE cell # NIL DO IF Rope.Equal[RopeForId[cell.id], RopeForId[name]] THEN RETURN[cell.access, cell.value]; cell _ cell.next; ENDLOOP; RETURN[NIL, NIL]; END; GenVisibleNames: PROC[vn: VisibleNames, for: PROC[name: IdNode, access: AccessValNode, value: REF ANY]] = BEGIN cell: VNCell _ vn.first; WHILE cell # NIL DO for[cell.id, cell.access, cell.value]; cell _ cell.next; ENDLOOP; END; <> <<>> ShowNested: PROC[on: IO.STREAM, nest: INT] = {FOR I: INT IN [0..nest) DO IO.PutRope[on, " "] ENDLOOP}; RopeForId: PROC[id: IdNode] RETURNS[Rope.ROPE] = {RETURN[IF id # NIL THEN id.text ELSE ""]}; <> ContextRibNode: TYPE = REF ContextRibNodeBody; ContextRibNodeBody: PUBLIC TYPE = RECORD[ lc: LocalContextNode]; RootContextRib: PUBLIC PROC RETURNS[rib: ContextRibNode] = {RETURN[FreezeLocalContext[CreateRootLocalContext[]]]}; <<(damages lc)>> FreezeLocalContext: PUBLIC PROC[lc: LocalContextNode] RETURNS[rib: ContextRibNode] = BEGIN lc.frozen _ TRUE; RETURN[NEW[ContextRibNodeBody_[lc]]]; END; RealShowRib: PROC[on: IO.STREAM, nest: INT, rib: ContextRibNode] = BEGIN IO.PutF[on, "Context Rib %g:", IO.int[LOOPHOLE[rib, INT]]]; IO.PutRope[on, "\N"]; ShowNested[on, nest+2]; RealShowLocalContext[on, nest+2, rib.lc]; END; <> ContextTreeNode: TYPE = REF ContextTreeNodeBody; ContextTreeNodeBody: PUBLIC TYPE = RECORD[ rib: ContextRibNode, subTrees: CTCell, lastSubTree: CTCell]; CTCell: TYPE = REF CTCellBody; CTCellBody: TYPE = RECORD[ ctn: ContextTreeNode, next: CTCell]; EmptyContextTree: PUBLIC PROC[rib: ContextRibNode] RETURNS[ContextTreeNode] = {RETURN[NEW[ContextTreeNodeBody _ [rib, NIL, NIL]]]}; <<(declared as damages ctn)>> FakeDamageContextTree: PUBLIC PROC[ctn: ContextTreeNode] RETURNS[ctnp: ContextTreeNode] = {RETURN[ctn]}; <<(damages ctn)>> AddSubContextTree: PUBLIC PROC[ctn: ContextTreeNode, subCtn: ContextTreeNode] RETURNS[ctnp: ContextTreeNode] = BEGIN cell: CTCell _ NEW[CTCellBody_[subCtn, NIL]]; IF subCtn.rib.lc.rib # ctn.rib THEN ErrorSignal[]; IF ctn.subTrees = NIL THEN ctn.subTrees _ cell ELSE ctn.lastSubTree.next _ cell; ctn.lastSubTree _ cell; RETURN[ctn]; END; RealShowTree: PROC[on: IO.STREAM, nest: INT, ct: ContextTreeNode] = BEGIN IO.PutF[on, "Context Tree %g:", IO.int[LOOPHOLE[ct, INT]]]; IO.PutRope[on, "\N"]; ShowNested[on, nest+2]; RealShowRib[on, nest+2, ct.rib]; IO.PutRope[on, "\N\N"]; ShowNested[on, nest+4]; FOR cell: CTCell _ ct.subTrees, cell.next WHILE cell # NIL DO RealShowTree[on, nest+4, cell.ctn]; IF cell = ct.lastSubTree THEN EXIT; ENDLOOP; END; <> DefaultExpCase: TYPE = {c1, c2, c3, c4, c5}; <> DefaultExpNode: TYPE = REF DefaultExpNodeBody; DefaultExpNodeBody: PUBLIC TYPE = RECORD[ case: DefaultExpCase, exp: ExpPTreeNode]; DefaultExpVal: PUBLIC PROC[case: Rope.ROPE, exp: ExpPTreeNode] RETURNS[DefaultExpNode] = BEGIN RETURN[NEW[DefaultExpNodeBody_[ SELECT TRUE FROM Rope.Equal[case, ""] => c1, Rope.Equal[case, "_"] => c2, Rope.Equal[case, "_e"] => c3, Rope.Equal[case, "_TRASH"] => c4, Rope.Equal[case, "_e|TRASH"] => c5, ENDCASE => ERROR, exp]]]; END; ShowDEN: PROC[on: IO.STREAM, nest: INT, den: DefaultExpNode] = BEGIN t1: Rope.ROPE _ SELECT den.case FROM c1 => "", c2 => "_ ", c3 => "_e ", c4 => "_TRASH ", c5 => "_e|TRASH ", ENDCASE => ERROR; t2: Rope.ROPE _ TextForExpPTree[den.exp]; IO.PutF[on, "<%g%g>", IO.rope[t1], IO.rope[t2]]; END; <> <<>> PositionValNode: TYPE = REF PositionValNodeBody; PositionValNodeBody: PUBLIC TYPE = RECORD[ index: ExpPTreeNode, bounds: BoundsValNode]; PositionValFun: PUBLIC PROC[index: ExpPTreeNode, bounds: BoundsValNode] RETURNS[PositionValNode] = {RETURN[NEW[PositionValNodeBody_[index, bounds]]]}; NullPosition: PUBLIC PROC RETURNS[PositionValNode] = {RETURN[NIL]}; ShowPVN: PROC[on: IO.STREAM, nest: INT, pvn: PositionValNode] = BEGIN IF pvn # NIL THEN BEGIN IO.PutF[on, "( %g ", IO.rope[TextForExpPTree[pvn.index]]]; ShowBVN[on, nest, pvn.bounds]; IO.PutF[on, " )"]; END; END; <> OpenClosed: TYPE = {open, closed}; BoundsValNode: TYPE = REF BoundsValNodeBody; BoundsValNodeBody: PUBLIC TYPE = RECORD[ left: OpenClosed, first, last: ExpPTreeNode, right: OpenClosed]; -- what about closed and open end points? BoundsValFun: PUBLIC PROC[leftBracket: Rope.ROPE, first: ExpPTreeNode, last: ExpPTreeNode, rightBracket: Rope.ROPE] RETURNS[BoundsValNode] = BEGIN bvn: BoundsValNode _ NEW[BoundsValNodeBody_[open, first, last, open]]; bvn.left _ SELECT TRUE FROM Rope.Equal["[", leftBracket] => closed, Rope.Equal["(", leftBracket] => open, ENDCASE => ERROR; bvn.right _ SELECT TRUE FROM Rope.Equal["]", rightBracket] => closed, Rope.Equal[")", rightBracket] => open, ENDCASE => ERROR; RETURN[bvn]; END; NullBounds: PUBLIC PROC RETURNS[BoundsValNode] = {RETURN[NIL]}; <> ShowBVN: PROC[on: IO.STREAM, nest: INT, bvn: BoundsValNode] = BEGIN IF bvn # NIL THEN BEGIN left: Rope.ROPE _ SELECT bvn.left FROM open => "(", closed => "[", ENDCASE => ERROR; right: Rope.ROPE _ SELECT bvn.right FROM open => ")", closed => "]", ENDCASE => ERROR; IO.PutF[on, ": %g%g..%g%g ", IO.rope[left], IO.rope[TextForExpPTree[bvn.first]], IO.rope[TextForExpPTree[bvn.last]], IO.rope[right]]; END; END; <> AccessValNode: TYPE = REF AccessValNodeBody; AccessValNodeBody: PUBLIC TYPE = AccessValSet; AccessValSet: TYPE = {empty, private, public}; AccessValConst: PUBLIC PROC[r: Rope.ROPE] RETURNS[AccessValNode] = BEGIN SELECT TRUE FROM Rope.Equal[r, "empty"] => RETURN[NEW[AccessValNodeBody_empty]]; Rope.Equal[r, "private"] => RETURN[NEW[AccessValNodeBody_private]]; Rope.Equal[r, "public"] => RETURN[NEW[AccessValNodeBody_public]]; ENDCASE => ErrorSignal[]; END; ShowAVN: PUBLIC PROC[on: IO.STREAM, nest: INT, avn: AccessValNode] = BEGIN IO.PutF[on, " %g", IO.rope[SELECT avn^ FROM empty => "empty", private => "private", public => "public", ENDCASE => ERROR]]; END; <> <<>> <> ExpPTreeNode: TYPE = REF ExpPTreeNodeBody; ExpPTreeNodeBody: PUBLIC TYPE = RECORD[node: ExpNode]; <> ExpPTreeVal: PUBLIC PROC[node: ExpNode] RETURNS[ExpPTreeNode] = {RETURN[NEW[ExpPTreeNodeBody_[node]]]}; NullExpPTree: PUBLIC PROC RETURNS[ExpPTreeNode] = {RETURN[NIL]}; TextForExpPTree: PROC[exp: ExpPTreeNode] RETURNS[Rope.ROPE] = {RETURN[IF (exp # NIL) THEN "exp" ELSE ""]}; <> ScopePTreeNode: TYPE = REF ScopePTreeNodeBody; ScopePTreeNodeBody: PUBLIC TYPE = RECORD[node: ScopeNode]; <> ScopePTreeVal: PUBLIC PROC[node: ScopeNode] RETURNS[ScopePTreeNode] = {RETURN[NEW[ScopePTreeNodeBody_[node]]]}; ScopeVal: PUBLIC PROC[box: ScopePTreeNode] RETURNS[ScopeNode] = {RETURN[box.node]}; <> <> ErrorSignal: PUBLIC ERROR = CODE; ShowLocalContext: PUBLIC PROC[on: IO.STREAM, nest: INT, lc: LocalContextNode] = {RealShowLocalContext[on, nest, lc]}; ShowContextRib: PUBLIC PROC[on: IO.STREAM, nest: INT, rib: ContextRibNode] = {RealShowRib[on, nest, rib]}; ShowContextTree: PUBLIC PROC[on: IO.STREAM, nest: INT, ct: ContextTreeNode] = {RealShowTree[on, nest, ct]}; <> True: PUBLIC PROC RETURNS[BOOLEAN] = {RETURN[TRUE]}; False: PUBLIC PROC RETURNS[BOOLEAN] = {RETURN[FALSE]}; BooleanConst: PUBLIC PROC[r: Rope.ROPE] RETURNS[BOOLEAN] = BEGIN SELECT TRUE FROM Rope.Equal[r, "True"] => RETURN[TRUE]; Rope.Equal[r, "False"] => RETURN[FALSE]; ENDCASE => ErrorSignal[]; END; Error: PUBLIC PROC[r: Rope.ROPE] RETURNS[BOOLEAN] = BEGIN ERROR END; NullId: PUBLIC PROC RETURNS[IdNode] = {RETURN[NIL]}; END..