
<<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.ROPE _ NIL, 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 BOOL _ NARROW[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: ROPE _ NIL, others: ROPES _ NIL] = {
        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: BOOL _ FALSE] = {
            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: ROPE _ NIL]
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: ROPES _ NIL] = {
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.