CoreSequenceImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Barth, November 6, 1985 9:03:51 am PST
Spreitzer, August 12, 1985 5:22:30 pm PDT
Bertrand Serlet November 27, 1985 10:13:22 pm PST
Louis Monier October 23, 1985 4:03:46 pm PDT
DIRECTORY Core, CoreClasses, CoreOps, CoreProperties, CoreSequence, IO;
CoreSequenceImpl:
CEDAR
PROGRAM
IMPORTS CoreClasses, CoreOps, CoreProperties, IO
EXPORTS CoreSequence =
BEGIN OPEN Core, CoreSequence;
sequenceCellClass: PUBLIC CellClass ← NEW[CellClassRec ← [name: "Sequence", recast: Recast, properties: CoreProperties.Props[[CoreOps.printClassProcProp, NEW[CoreOps.PrintClassProc ← PropPrintClass]]]]];
Recast: RecastProc = {
seqCell: SequenceCellType ← NARROW [me.data];
stitchesLength: NAT ← IF seqCell.stitches#NIL THEN seqCell.stitches.length ELSE 0;
public: Wire ← CoreOps.CopyWire[me.public];
newInternal: Wire ← CoreOps.CreateWire[size: public.size + stitchesLength];
instances: LIST OF CoreClasses.CellInstance ← NIL;
FOR w:
NAT
IN [0 .. public.size)
DO
newInternal[w] ← public[w];
ENDLOOP;
FOR w:
NAT
IN [public.size .. newInternal.size)
DO
newInternal[w] ← NEW[WireRec];
CoreProperties.PutWireProp[newInternal[w], CoreOps.sequenceProp, CoreOps.sequenceProp];
newInternal[w] ← CoreOps.CreateWire[size: seqCell.count];
ENDLOOP;
FOR cell:
NAT
IN [0 .. seqCell.count)
DO
newWire: Wire ← NEW [Core.WireRec[public.size] ← public^];
FOR seqWire:
NAT
IN [0..seqCell.length)
DO
seqElement: NAT ← seqCell.sequence[seqWire];
IF CoreProperties.GetWireProp[seqCell.base.public[seqElement], CoreOps.sequenceProp]#
NIL
THEN {
size: NAT ← seqCell.base.public[seqElement].size;
actWire: Wire ← CoreOps.CreateWire[size: size];
CoreProperties.PutWireProp[actWire, CoreOps.sequenceProp, CoreOps.sequenceProp];
FOR i:
NAT
IN [0..size)
DO
actWire[i] ← newWire[seqElement][(size*cell)+i];
ENDLOOP;
newWire[seqElement] ← actWire;
}
ELSE newWire[seqElement] ← newWire[seqElement][cell];
ENDLOOP;
IF stitchesLength>0 THEN ERROR; -- not yet implemented
FOR stitchWire:
NAT
IN [0..stitchesLength)
DO
internal: Wire;
IF cell < seqCell.count -1
THEN {
internal ← CoreOps.CopyWire[wire: seqCell.base.public[seqCell.stitches[stitchWire].source]];
newInternal[stitchWire + public.size][cell] ← internal;
newWire[seqCell.stitches[stitchWire].source] ← internal;
};
IF cell > 0 THEN newWire[seqCell.stitches[stitchWire].sink] ← newInternal[stitchWire + public.size][cell-1];
ENDLOOP;
instances ←
CONS [
NEW [CoreClasses.CellInstanceRec ← [
actual: newWire,
type: seqCell.base,
properties: IF CoreOps.GetCellTypeName[seqCell.base]=NIL THEN NIL ELSE CoreProperties.Props[[CoreOps.nameProp, IO.PutFR["%g%g", IO.rope[CoreOps.GetCellTypeName[seqCell.base]], IO.int[cell]]]]
]],
instances];
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:
ROPE ←
NIL, props: Properties ←
NIL]
RETURNS [cellType: CellType] = {
cellType ← CoreOps.CreateCellType[
class: sequenceCellClass,
public: CoreOps.CopyWire[args.base.public],
data: args,
name: name,
props: props];
FOR i: NAT IN [0 .. cellType.public.size) DO IF CoreOps.GetWireName[cellType.public[i]]=NIL THEN ERROR ENDLOOP; -- check that each top level wire is named (otherwise, it is probably a bug)
FOR i:
NAT
IN [0 .. args.length)
DO
wire: Wire ← cellType.public[args.sequence[i]];
IF CoreProperties.GetWireProp[wire, CoreOps.sequenceProp]#
NIL
THEN {
newSeqLength: NAT ← args.count * wire.size;
newSeq: Wire ← CoreOps.CreateWire[size: newSeqLength, props: CoreProperties.CopyProps[wire.properties]];
FOR i:
NAT
IN [0 .. newSeqLength)
DO
newSeq[i] ← CoreOps.CopyWire[wire[0]];
CoreProperties.PutWireProp[newSeq[i], CoreOps.nameProp, NIL];
ENDLOOP;
cellType.public[args.sequence[i]] ← newSeq;
}
ELSE {
newWire: Wire ← CoreOps.CreateWire[size: args.count, name: CoreOps.GetWireName[wire], props: CoreProperties.Props[[CoreOps.sequenceProp, CoreOps.sequenceProp]]];
FOR i:
NAT
IN [0 .. args.count)
DO
newWire[i] ← CoreOps.CopyWire[wire];
CoreProperties.PutWireProp[newWire[i], CoreOps.nameProp, NIL];
ENDLOOP;
cellType.public[args.sequence[i]] ← newWire;
};
ENDLOOP;
};
PropPrintClass: CoreOps.PrintClassProc = {Print[NARROW[data], out]};
Print:
PUBLIC
PROC [cell: SequenceCellType, out:
IO.
STREAM] = {
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, "\nstitch wires:"];
IF cell.stitches#
NIL
THEN
FOR stitch:
NAT
IN [0 .. cell.stitches.length)
DO
IO.PutF[out, " (%g, %g)", IO.rope[CoreOps.GetWireName[cell.base.public[cell.stitches[stitch].source]]], IO.rope[CoreOps.GetWireName[cell.base.public[cell.stitches[stitch].sink]]]];
ENDLOOP;
IO.PutRope[out, "\nsequence wires:"];
FOR seq:
NAT
IN [0 .. cell.length)
DO
IO.PutF[out, " %g", IO.rope[CoreOps.GetWireName[cell.base.public[cell[seq]]]]];
ENDLOOP;
};
END.