CoreSequenceImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Barth, March 18, 1986 12:00:19 pm PST
Spreitzer, August 12, 1985 5:22:30 pm PDT
Bertrand Serlet March 4, 1986 2:00:35 pm PST
Louis Monier October 23, 1985 4:03:46 pm PDT
DIRECTORY Commander, Core, CoreClasses, CoreOps, CoreProperties, CoreSequence, IO, ProcessProps;
CoreSequenceImpl: CEDAR PROGRAM
IMPORTS CoreClasses, CoreOps, CoreProperties, IO, ProcessProps
EXPORTS CoreSequence =
BEGIN OPEN Core, CoreSequence;
sequenceCellClass: PUBLIC CellClass ← CoreOps.SetClassPrintProc[NEW[CellClassRec ← [name: "Sequence",recast: Recast]], PropPrintClass];
Recast: RecastProc = {
seqCell: SequenceCellType ← NARROW[me.data];
public: Wire ← CoreOps.CopyWire[me.public];
newInternal: Wire ← NEW[WireRec[public.size+seqCell.count]];
instances: LIST OF CoreClasses.CellInstance ← NIL;
FOR w: NAT IN [0..public.size) DO
newInternal[w] ← public[w];
ENDLOOP;
FOR cell: NAT DECREASING IN [0..seqCell.count) DO
newWire: Wire ← NEW[WireRec[public.size] ← public^];
cellTypeName: ROPE ← CoreOps.GetCellTypeName[seqCell.base];
IF seqCell.sequence#NIL THEN FOR seqWire: NAT IN [0..seqCell.sequence.length) DO
seqElement: NAT ← seqCell.sequence[seqWire];
newWire[seqElement] ← newWire[seqElement][cell];
ENDLOOP;
IF seqCell.flatSequence#NIL THEN FOR seqWire: NAT IN [0..seqCell.flatSequence.length) DO
seqElement: NAT ← seqCell.flatSequence[seqWire];
size: NAT ← seqCell.base.public[seqElement].size;
actWire: Wire ← NEW[WireRec[size]];
FOR i: NAT IN [0..size) DO
actWire[i] ← newWire[seqElement][(size*cell)+i];
ENDLOOP;
newWire[seqElement] ← actWire;
ENDLOOP;
instances ← CONS [CoreClasses.CreateInstance[
actual: newWire,
type: seqCell.base,
name: IF cellTypeName=NIL THEN NIL ELSE IO.PutFR["%g%g", IO.rope[cellTypeName], IO.int[cell]]],
instances];
newInternal[public.size+cell] ← newWire;
ENDLOOP;
new ← CoreClasses.CreateRecordCell[
public: public,
internal: newInternal,
instances: instances,
name: CoreOps.GetCellTypeName[me],
props: CoreProperties.CopyProps[propList: me.properties]];
};
Create: PUBLIC PROC [args: SequenceCellType, name: ROPENIL, props: Properties ← NIL] RETURNS [cellType: CellType] = {
public: Wire ← CoreOps.CopyWire[args.base.public];
IF args.sequence#NIL THEN FOR seq: NAT IN [0..args.sequence.length) DO
wire: Wire ← public[args.sequence[seq]];
newWire: Wire ← NEW[WireRec[args.count]];
FOR i: NAT IN [0 .. args.count) DO
newWire[i] ← CoreOps.SetShortWireName[CoreOps.CopyWire[wire], NIL];
ENDLOOP;
public[args.sequence[seq]] ← CoreOps.SetShortWireName[newWire, CoreOps.GetShortWireName[wire]];
ENDLOOP;
IF args.flatSequence#NIL THEN FOR seq: NAT IN [0..args.flatSequence.length) DO
wire: Wire ← public[args.flatSequence[seq]];
newSeqLength: NAT ← args.count * wire.size;
newSeq: Wire ← NEW[WireRec[newSeqLength]];
IF wire.size=0 THEN ERROR;
newSeq.properties ← CoreProperties.CopyProps[wire.properties];
FOR i: NAT IN [0..newSeqLength) DO
newSeq[i] ← CoreOps.SetShortWireName[CoreOps.CopyWire[wire[0]], NIL];
ENDLOOP;
public[args.flatSequence[seq]] ← newSeq;
ENDLOOP;
cellType ← CoreOps.CreateCellType[
class: sequenceCellClass,
public: public,
data: args,
name: name,
props: props];
};
PropPrintClass: CoreOps.PrintClassProc = {Print[NARROW[data], out]};
Print: PUBLIC PROC [cell: SequenceCellType, out: IO.STREAMNIL] = {
IF out=NIL THEN out ← NARROW[ProcessProps.GetProp[$CommanderHandle], Commander.Handle].out;
IO.PutF[out, "\n\nBase cell type: %g", IO.rope[CoreOps.GetCellTypeName[cell.base]]];
IO.PutF[out, ", count: %g", IO.int[cell.count]];
IO.PutRope[out, "\nsequence wires:"];
IF cell.sequence#NIL THEN FOR seq: NAT IN [0 .. cell.sequence.length) DO
IO.PutF[out, " %g", IO.rope[CoreOps.GetShortWireName[ cell.base.public[cell.sequence[seq]]]]];
ENDLOOP;
IO.PutRope[out, "\nflat sequence wires:"];
IF cell.flatSequence#NIL THEN FOR seq: NAT IN [0 .. cell.flatSequence.length) DO
IO.PutF[out, " %g", IO.rope[CoreOps.GetShortWireName[ cell.base.public[cell.flatSequence[seq]]]]];
ENDLOOP;
};
END.