SequenceImpl.mesa
Copyright Ó 1988 by Xerox Corporation. All rights reserved.
Barth, July 8, 1988 4:06:11 pm PDT
DIRECTORY
Atom, Basics, CD, CDBasics, CDCells, CDDirectory, CDOps, CDProperties, CDRects, CDSatellites, CDSequencer, CDSequencerExtras, Core, CoreClasses, CoreOps, CoreGeometry, CoreProperties, IO, RefTab, Rope, Sequence, Sinix, Sisyph, TerminalIO;
SequenceImpl: CEDAR PROGRAM
IMPORTS Atom, CD, CDBasics, CDCells, CDDirectory, CDOps, CDProperties, CDRects, CDSatellites, CDSequencerExtras, CoreClasses, CoreOps, CoreGeometry, CoreProperties, IO, RefTab, Rope, Sinix, Sisyph, TerminalIO
EXPORTS Sequence
SHARES Sinix, Sisyph = BEGIN OPEN Sequence;
ROPE: TYPE = Rope.ROPE;
ROPES: TYPE = LIST OF ROPE;
Wire: TYPE = Core.Wire;
Wires: TYPE = Core.Wires;
CellType: TYPE = Core.CellType;
CellClass: TYPE = Core.CellClass;
Properties: TYPE = Core.Properties;
Sequence
sequenceCellClass: PUBLIC Core.CellClass ← CoreOps.SetClassPrintProc[NEW [Core.CellClassRec ← [name: "Sequence", recast: RecastSequence, layersProps: FALSE]], PrintSequence];
exposeAtoms: ARRAY PublicWireType OF ATOM ← [$Sequence, $FlatSequence, $Common, $First, $Last];
PrintSequence: CoreOps.PrintClassProc = {
EachOperation: RefTab.EachPairAction = {
wire: Core.Wire ← NARROW[key];
operation: Operation ← NARROW[val];
IO.PutF[out, "%g", IO.rope[CoreOps.GetShortWireName[wire]]];
FOR exposition: PublicWireType IN PublicWireType DO
IF operation.expose[exposition] THEN {
IO.PutRope[out, " "];
IO.PutRope[out, Atom.GetPName[exposeAtoms[exposition]]];
};
ENDLOOP;
IO.PutRope[out, "\n"];
};
cell: SequenceCellType ← NARROW [data];
IO.PutF[out, "\n\nBase cell type: %g", IO.rope[CoreOps.GetCellTypeName[cell.base]]];
IO.PutF[out, ", count: %g\n", IO.int[cell.count]];
FOR binds: WireBindings ← cell.bindings, binds.rest UNTIL binds=NIL DO
IO.PutF[out, "this: %g, that: %g\n", IO.rope[CoreOps.GetShortWireName[binds.first.this]], IO.rope[CoreOps.GetShortWireName[binds.first.that]]];
ENDLOOP;
[] ← RefTab.Pairs[cell.operations, EachOperation];
};
CreateSequence: PUBLIC PROC [base: Core.CellType, count: NAT, bindings: WireBindings ← NIL, operations: Operations ← NIL, name: Rope.ROPENIL, props: Core.Properties ← NIL, decorateProc: DecorateProc ← NIL] RETURNS [cellType: Core.CellType] = {
cellType ← CoreOps.CreateCellType[
class: sequenceCellClass,
public: CoreOps.CreateWire[ComputeSequence[base, count, bindings, operations, decorateProc].publics],
data: NEW[SequenceCellTypeRec ← [
base: base,
count: count,
bindings: bindings,
operations: operations]],
name: name,
props: props];
};
RecastSequence: Core.RecastProc = {
data: SequenceCellType ← NARROW[me.data];
publics: Core.Wires ← NIL;
internals: Core.Wires ← NIL;
instances: LIST OF CoreClasses.CellInstance ← NIL;
[internals, instances, publics] ← ComputeSequence[data.base, data.count, data.bindings, data.operations];
new ← CoreClasses.CreateRecordCell[
public: CoreOps.CreateWire[publics],
internal: CoreOps.CreateWire[internals],
instances: instances,
name: CoreOps.GetCellTypeName[me],
props: NIL];
};
BindTables: TYPE = REF BindTablesRec;
BindTablesRec: TYPE = RECORD[tables: SEQUENCE size: NAT OF RefTab.Ref];
ComputeSequence: PROC [base: Core.CellType, count: NAT, bindings: WireBindings ← NIL, operations: Operations ← NIL, decorateProc: DecorateProc ← NIL] RETURNS [internals: Core.Wires ← NIL, instances: LIST OF CoreClasses.CellInstance ← NIL, publics: LIST OF Core.Wire ← NIL] = {
RootWire: PROC [wire: Core.Wire] RETURNS [root: Core.Wire] = {
root ← NARROW [RefTab.Fetch[actualBind, wire].val];
IF root#wire THEN {
root ← RootWire[root];
[] ← RefTab.Replace[actualBind, wire, root];
};
};
BindActual: PROC [replace, by: Core.Wire] = {
IF replace.size#by.size THEN ERROR; -- binding mismatching wires
[] ← RefTab.Replace[actualBind, RootWire[replace], RootWire[by]];
FOR i: NAT IN [0..replace.size) DO
BindActual[replace[i], by[i]];
ENDLOOP;
};
EachOperation: RefTab.EachPairAction = {
FetchActual: PROC [cell: NAT, public: Core.Wire] RETURNS [actual: Core.Wire] = {
actual ← NARROW[RefTab.Fetch[publicsToActuals[cell], public].val];
actual ← CoreOps.SetShortWireName[RootWire[actual], NIL];
};
basePublic: Core.Wire ← NARROW[key];
name: Rope.ROPE ← CoreOps.GetShortWireName[basePublic];
expose: ARRAY PublicWireType OF BOOLNARROW[val, Operation].expose;
exposed: ARRAY PublicWireType OF Core.Wire ← ALL[NIL];
firstActual: Core.Wire ← RootWire[NARROW[RefTab.Fetch[publicsToActuals[0], basePublic].val]];
lastActual: Core.Wire ← RootWire[NARROW[RefTab.Fetch[publicsToActuals[count-1], basePublic].val]];
IF expose[sequence] THEN {
sequenceWire: Core.Wire ← NEW[Core.WireRec[count]];
FOR cell: NAT IN [0..count) DO
sequenceWire[cell] ← FetchActual[cell, basePublic];
ENDLOOP;
publics ← CONS[sequenceWire, publics];
IF name#NIL THEN [] ← CoreOps.SetShortWireName[sequenceWire, Rope.Cat[name, Atom.GetPName[exposeAtoms[sequence]]]];
exposed[sequence] ← sequenceWire;
};
IF expose[flatSequence] THEN {
size: NAT ← basePublic.size;
sequenceWire: Core.Wire ← NEW[Core.WireRec[size*count]];
FOR cell: NAT IN [0..count) DO
FOR i: NAT IN [0..size) DO
sequenceWire[(size*cell)+i] ← FetchActual[cell, basePublic[i]];
ENDLOOP;
ENDLOOP;
publics ← CONS[sequenceWire, publics];
IF name#NIL THEN [] ← CoreOps.SetShortWireName[sequenceWire, Rope.Cat[name, Atom.GetPName[exposeAtoms[flatSequence]]]];
exposed[flatSequence] ← sequenceWire;
};
IF expose[last] THEN {
IF NOT expose[first] OR firstActual#lastActual THEN publics ← CONS[lastActual, publics];
IF name#NIL THEN [] ← CoreOps.SetShortWireName[lastActual, Rope.Cat[name, Atom.GetPName[exposeAtoms[last]]]];
exposed[last] ← lastActual;
};
IF expose[first] THEN {
publics ← CONS[firstActual, publics];
IF name#NIL THEN [] ← CoreOps.SetShortWireName[firstActual, Rope.Cat[name, Atom.GetPName[exposeAtoms[first]]]];
exposed[first] ← firstActual;
};
IF expose[common] THEN {
IF NOT (expose[last] OR expose[first]) THEN publics ← CONS[firstActual, publics];
FOR cell: NAT IN [0..count) DO
IF RootWire[NARROW[RefTab.Fetch[publicsToActuals[cell], basePublic].val]]#firstActual THEN ERROR;
ENDLOOP;
IF name#NIL THEN [] ← CoreOps.SetShortWireName[firstActual, name];
exposed[common] ← firstActual;
};
IF decorateProc#NIL THEN decorateProc[basePublic, exposed];
};
publicsToActuals: BindTables ← NEW[BindTablesRec[count]];
actualBind: RefTab.Ref ← RefTab.Create[];
baseName: ROPE ← CoreOps.GetCellTypeName[base];
FOR cell: NAT DECREASING IN [0..count) DO
InsertBinding: CoreOps.EachWirePairProc = {
[] ← RefTab.Store[publicsToActuals[cell], publicWire, actualWire];
};
InitActual: CoreOps.EachWireProc = {
[] ← RefTab.Insert[actualBind, wire, wire];
};
actual: Core.Wire ← CoreOps.CopyWireUsingTable[base.public, RefTab.Create[], FALSE];
internals ← CONS[actual, internals];
instances ← CONS [CoreClasses.CreateInstance[
actual: actual,
type: base,
name: IF baseName=NIL THEN NIL ELSE IO.PutFR["%g%g", IO.rope[baseName], IO.int[cell]]],
instances];
publicsToActuals[cell] ← RefTab.Create[];
[] ← CoreOps.VisitBindingSeq[actual, base.public, InsertBinding];
[] ← CoreOps.VisitWire[actual, InitActual];
ENDLOOP;
FOR cell: NAT IN [0..count-1) DO
FOR wpl: WireBindings ← bindings, wpl.rest UNTIL wpl=NIL DO
oldActual: Core.Wire ← NARROW[RefTab.Fetch[publicsToActuals[cell], wpl.first.that].val];
newActual: Core.Wire ← NARROW[RefTab.Fetch[publicsToActuals[cell+1], wpl.first.this].val];
BindActual[newActual, oldActual];
ENDLOOP;
ENDLOOP;
FOR ins: LIST OF CoreClasses.CellInstance ← instances, ins.rest UNTIL ins=NIL DO
FixActual: PROC [old: Core.Wire] RETURNS [new: Core.Wire] = {
new ← RootWire[old];
FOR wireIndex: NAT IN [0..new.size) DO
new[wireIndex] ← FixActual[old[wireIndex]];
ENDLOOP;
};
IF ins.first.actual#FixActual[ins.first.actual] THEN ERROR;
ENDLOOP;
[] ← RefTab.Pairs[operations, EachOperation];
FOR wires: Core.Wires ← CoreOps.Reverse[publics], wires.rest UNTIL wires=NIL DO
internals ← CONS[wires.first, internals];
ENDLOOP;
};
Icon Commands
MakeSequenceIcon: PROC [comm: CDSequencer.Command] = {
selected: CD.Instance ← TheCellInstance[comm.design, "MakeSequenceIcon\n"];
IF selected=NIL THEN RETURN;
CleanUpIconProperties[selected.ob];
CDProperties.PutObjectProp[selected.ob, Sisyph.mode.extractProcProp, $NewSequenceExtractSequence];
IF ParseSatellites[CDSatellites.GetSatelliteRopes[selected.ob]].keyword=NIL THEN TerminalIO.PutF["*** Warning: there is no satellite of the form 'Seq: Expression'.\n"];
TerminalIO.PutF["Sequencing of %g done.\n", IO.rope[CDDirectory.Name[selected.ob, comm.design]]];
};
Sequence Icons
ParseSatellites: PROC [ropes: ROPES] RETURNS [keyword, expr: ROPENIL, others: ROPESNIL] = {
WHILE ropes#NIL DO
tokenKind1, tokenKind2: IO.TokenKind; token1, token2: ROPE; rest: ROPE;
[tokenKind1, token1, rest] ← Sisyph.ParseRope[ropes.first];
[tokenKind2, token2, rest] ← Sisyph.ParseRope[rest];
IF tokenKind1=tokenID AND Rope.Equal[token1, "Seq"] AND Sisyph.IsParsedChar[tokenKind2, token2, ':] THEN {
IF keyword=NIL THEN {keyword ← token1; expr ← rest} ELSE ERROR;
}
ELSE others ← CONS [ropes.first, others];
ropes ← ropes.rest;
ENDLOOP;
};
ExtractSequence: Sinix.ExtractProc = {
name: ROPE ← mode.nameProc[obj, userData];
cx: Sisyph.Context;
keyword, expr: ROPE;
others: ROPES;
cellType: CellType;
count: NAT;
[keyword, expr, others] ← ParseSatellites[NARROW [CDProperties.GetObjectProp[obj, Sinix.satellitesProp]]];
IF keyword=NIL THEN {
TerminalIO.PutF["*** SisyphExtractSequence: Sequence does not contain any of sequencing information (e.g. an object satellite 'Seq: 32').\n"];
ERROR};
CDProperties.PutObjectProp[obj, Sinix.satellitesProp, others];
cx ← Sisyph.EvaluateParameters[userData, obj, properties];
Sisyph.EvalExpr[cx, keyword, expr, FALSE];
count ← NAT [Sisyph.FetchInt[cx, keyword].value];
Sinix.PutF["Extracting [Sisyph] cell %g (%g: %g)\n", IO.rope[name], IO.rope[keyword], IO.int[count]];
name ← Rope.Substr[name, 0, Rope.Index[name, 0, ".sch"]]; -- hack
name ← Rope.Substr[name, 0, Rope.Index[name, 0, ".icon"]]; -- hack
cellType ← ExtractSequenceIcon[obj, cx, keyword, count, name, Sisyph.GetCoreProps[cx]];
props ← Sisyph.GetCoreInstProps[cx];
result ← cellType};
publicWireTypeBBox: ARRAY PublicWireType OF CoreGeometry.Rect = [
[0, 0, 4, 32], -- sequence
[0, 0, 4, 28], -- flatSequence
[0, 0, 4, 24], -- common
[0, 0, 4, 20], -- first
[0, 0, 4, 16]]; -- last
ExtractSequenceIcon: PROC [obj: CD.Object, cx: Sisyph.Context, resultVar: ROPE, count: NAT, name: ROPE, props: Core.Properties] RETURNS [sequence: CellType] = {
AddOp: PROC [wire: Core.Wire, expose: PublicWireType] = {
operation: Operation ← NARROW[RefTab.Fetch[operations, wire].val];
IF operation=NIL THEN {
operation ← NEW[OperationRec];
IF NOT RefTab.Store[operations, wire, operation] THEN ERROR;
};
operation.expose[expose] ← TRUE;
};
MatchingPins: PROC [firstPin, lastPin: CoreGeometry.Instance] RETURNS [yes: BOOLFALSE] = {
TransformPin: PROC [instance: CoreGeometry.Instance] RETURNS [pinIR: CoreGeometry.Rect] = {
pinIR ← CDBasics.MoveRect[CDBasics.MapRect[ CD.InterestRect[instance.obj], instance.trans], CDBasics.SubPoints[[0, 0], CDBasics.BaseOfRect[ir]]];
};
firstSides: CoreGeometry.Sides ← CoreGeometry.GetSides[ir, firstPin];
lastSides: CoreGeometry.Sides ← CoreGeometry.GetSides[ir, lastPin];
IF (firstSides[top] AND lastSides[bottom]) OR (firstSides[bottom] AND lastSides[top]) OR (firstSides[left] AND lastSides[right]) OR (firstSides[right] AND lastSides[left]) THEN {
firstBBox: CoreGeometry.Rect ← TransformPin[firstPin];
lastBBox: CoreGeometry.Rect ← TransformPin[lastPin];
firstMin, firstMax, lastMin, lastMax: INT ← 0;
IF firstSides[top] OR firstSides[bottom] THEN {
firstMin ← firstBBox.x1;
firstMax ← firstBBox.x2;
lastMin ← lastBBox.x1;
lastMax ← lastBBox.x2;
}
ELSE {
firstMin ← firstBBox.y1;
firstMax ← firstBBox.y2;
lastMin ← lastBBox.y1;
lastMax ← lastBBox.y2;
};
yes firstMin<=lastMax AND firstMax>=lastMin;
};
};
BindingsAndOps: CoreOps.EachWirePairProc = {
IF CoreProperties.GetWireProp[actualWire, exposeAtoms[common]]#NIL THEN {
bindings ← CONS[[publicWire, publicWire], bindings];
AddOp[publicWire, common];
};
IF CoreProperties.GetWireProp[actualWire, exposeAtoms[sequence]]#NIL THEN AddOp[publicWire, sequence];
IF CoreProperties.GetWireProp[actualWire, exposeAtoms[flatSequence]]#NIL THEN AddOp[publicWire, flatSequence];
IF CoreProperties.GetWireProp[actualWire, exposeAtoms[last]]#NIL THEN AddOp[publicWire, last];
IF CoreProperties.GetWireProp[actualWire, exposeAtoms[first]]#NIL THEN {
EachFirstPin: CoreGeometry.EachInstanceProc = {
firstPin: CoreGeometry.Instance ← instance;
IF CDRects.IsBareRect[instance.obj] AND instance.obj.bbox = publicWireTypeBBox[first] THEN {
FindMatchingWire: CoreOps.EachWirePairProc = {
EachLastPin: CoreGeometry.EachInstanceProc = {
IF CDRects.IsBareRect[instance.obj] AND instance.obj.bbox = publicWireTypeBBox[last] AND MatchingPins[firstPin, instance] THEN bindings ← CONS[[firstWire, publicWire], bindings];
};
IF CoreProperties.GetWireProp[actualWire, exposeAtoms[last]]#NIL THEN [] ← CoreGeometry.EnumeratePins[Sisyph.mode.decoration, actualWire, EachLastPin];
};
[] ← CoreOps.VisitBinding[parentRCT[0].actual, base.public, FindMatchingWire];
};
};
firstWire: Core.Wire ← publicWire;
AddOp[publicWire, first];
[] ← CoreGeometry.EnumeratePins[Sisyph.mode.decoration, actualWire, EachFirstPin];
};
};
Decorate: DecorateProc = {
DecoratePin: CoreGeometry.EachInstanceProc = {
IF CDRects.IsBareRect[instance.obj] THEN FOR exposition: PublicWireType IN PublicWireType DO
IF publicWireTypeBBox[exposition]=instance.obj.bbox THEN {
pins: CoreGeometry.Instances ← CoreGeometry.GetPins[Sisyph.mode.decoration, parentWires[exposition]];
CoreGeometry.PutPins[Sisyph.mode.decoration, parentWires[exposition], CONS[instance, pins]];
EXIT;
};
REPEAT FINISHED => ERROR;
ENDLOOP;
};
actualWire: Core.Wire ← CoreOps.CorrespondingActual[parentRCT[0].actual, base.public, baseWire];
[] ← CoreGeometry.EnumeratePins[Sisyph.mode.decoration, actualWire, DecoratePin];
};
parent: CellType = NARROW[Sinix.ExtractCell[obj, Sisyph.mode, NIL, cx].result];
parentRCT: CoreClasses.RecordCellType = NARROW[parent.data];
base: CellType;
bindings: WireBindings ← NIL;
operations: Operations ← RefTab.Create[];
ir: CoreGeometry.Rect ← CD.InterestRect[CoreGeometry.GetObject[Sisyph.mode.decoration, parent]];
There should be only one subcell
IF parentRCT.size#1 THEN {
TerminalIO.PutF["*** SisyphExtractSequence: Sequence should contain one and only one subcell.\n"];
ERROR};
base ← parentRCT[0].type;
We deal with Global Variables
Sisyph.ProcessGlobalNames[parent, cx];
Compatibility hack
FOR wireIndex: NAT IN [0..parent.public.size) DO
IF parent.public[wireIndex].size=0 THEN {
FOR exposition: PublicWireType IN PublicWireType DO
IF CoreProperties.GetWireProp[parent.public[wireIndex], exposeAtoms[exposition]]#NIL THEN EXIT;
REPEAT FINISHED => CoreProperties.PutWireProp[parent.public[wireIndex], exposeAtoms[common], $present];
ENDLOOP;
};
ENDLOOP;
We check that there is no internal only
FOR i: NAT IN [0 .. parentRCT.internal.size) DO
wire: Wire = parentRCT.internal[i];
name: ROPE ← CoreOps.GetShortWireName[wire];
IF name=NIL THEN name ← "some wire";
SELECT TRUE FROM
NOT CoreOps.RecursiveMember[parentRCT[0].actual, wire] => {
TerminalIO.PutF["*** SisyphExtractSequence: %g is not connected to subcell.\n", IO.rope[name]];
ERROR;
};
NOT CoreOps.RecursiveMember[parent.public, wire] => {
TerminalIO.PutF["*** SisyphExtractSequence: %g is not public.\n", IO.rope[name]];
ERROR;
};
ENDCASE;
ENDLOOP;
We compute the bindings and operations
[] ← CoreOps.VisitBinding[parentRCT[0].actual, base.public, BindingsAndOps];
We create the sequence
sequence ← CreateSequence[base, count, bindings, operations, name, props, Decorate];
The object decoration!
CoreGeometry.PutObject[Sisyph.mode.decoration, sequence, obj];
};
CopyWireProperties: PROC[from, to: Wire] = {
EachProp: PROC[atom:ATOM, ref: REF] = {
CoreProperties.PutWireProp[to, atom, ref];
};
CoreProperties.Enumerate[from.properties, EachProp];
};
Internal Utilities
TheCellInstance: PROC [design: CD.Design, text: ROPENIL]
RETURNS [inst: CD.Instance ← NIL] = {
inst ← CDOps.TheInstance[design, text];
IF inst=NIL OR CDCells.IsCell[inst.ob] THEN RETURN;
TerminalIO.PutF["*** Selected instance is not a cell—can't do it.\n"];
inst ← NIL};
CleanUpIconProperties: PROC [obj: CD.Object] = {
Sinix.FlushCache[obj];
CDProperties.PutObjectProp[obj, $IconFor, NIL];
CDProperties.PutObjectProp[obj, $CodeFor, NIL];
CDProperties.PutObjectProp[obj, Sisyph.mode.extractProcProp, NIL];
CDProperties.PutObjectProp[obj, Sisyph.expressionsProp, StripResultExprs
[NARROW [CDProperties.GetObjectProp[obj, Sisyph.expressionsProp]]]] };
Soon obsolete?
StripResultExprs: PROC [in: ROPES] RETURNS [out: ROPESNIL] = {
FOR l: ROPES ← in, l.rest WHILE l#NIL DO
expr: ROPE ← l.first;
IF NOT Rope.Match[expr, "*cI*←*"]
AND NOT Rope.Match[expr, "*wI*←*"]
AND NOT Rope.Match[expr, "*wire*←*"] THEN out ← CONS [expr, out];
ENDLOOP;
};
Initialization
Sinix.RegisterExtractProc[$NewSequenceExtractSequence, ExtractSequence];
CDSequencerExtras.RegisterCommand[key: $MakeNewSequenceIcon, proc: MakeSequenceIcon, queue: doQueue];
END.