DIRECTORY
Convert, 
Core, CoreClasses, CoreOps, CoreProperties,
IO,
Pipal, PipalConnect, PipalCore, PipalIO, PipalMos, PipalSinix, PipalSisyph,
RefTab, Rope, RopeList,
Scheme,
TerminalIO;

PipalSisyphImpl: CEDAR PROGRAM				
IMPORTS Convert, CoreClasses, CoreOps, CoreProperties, IO, Pipal, PipalConnect, PipalCore, PipalIO, PipalMos, PipalSinix, RefTab, Rope, RopeList, Scheme, TerminalIO 
EXPORTS PipalSisyph
SHARES PipalSinix = 
BEGIN OPEN PipalSisyph; 
Context: TYPE = PipalSinix.Context;
Environment: TYPE = Scheme.Environment;
Any: TYPE = Scheme.Any;
CellType: TYPE = Core.CellType;
Wire: TYPE = Core.Wire;
Wires: TYPE = Core.Wires;
WireSeq: TYPE = Core.WireSeq;
ROPE: TYPE = Core.ROPE;
ROPES: TYPE = LIST OF ROPE;
Object: TYPE = Pipal.Object;
defaultGlobalNames: PUBLIC ROPES _ LIST ["Vdd", "Gnd", "RosemaryLogicTime"];
globalNames: PUBLIC ROPES _ defaultGlobalNames;

instanceExpressionsProp: PUBLIC ATOM _ $SisyphInstanceExpressions;
objectExpressionsProp: PUBLIC ATOM _ $SisyphObjectExpressions;

mode: PUBLIC PipalSinix.Mode _ NEW [PipalSinix.ModeRec _ [
decoration: PipalCore.schematicsDecoration,
extractMethod: Pipal.RegisterMethod["SchematicExtraction"],
connectMode: PipalConnect.schematicMode,
extractAnnotationProp: $SisyphExtractProc, -- for the sake of compatibility!
objectEqual: ObjectEqual,
postProcessFused: PostProcessFused
]];
Extract: PUBLIC PROC [name: ROPE, parameters: LIST OF IntegerParameter _ NIL] RETURNS [CellType] = {
context: Context _ CreateContext[];
object: Pipal.Object _ PipalIO.Fetch[name];
IF object=NIL THEN {TerminalIO.PutF["*** Error: ES cannot find object '%g'.\n", IO.rope[name]]; ERROR};
FOR list: LIST OF IntegerParameter _ parameters, list.rest WHILE list#NIL DO
Define[context, list.first.variable, NEW [INT _ list.first.value]];
ENDLOOP;
RETURN [NARROW [PipalSinix.Extract[object, mode, context].result]];
};
initialEnvironment: Environment = Scheme.NewEnvironmentStructure[];

IsDefinedTopLevel: PROC [env: Environment, variable: ATOM] RETURNS [BOOL] = {
values: RefTab.Ref _ NARROW [env.values];
RETURN [RefTab.Fetch[values, variable].found];
};

InternalDefine: PROC [env: Environment, variable: ATOM, value: Any] = {
IF IsDefinedTopLevel[env, variable] 
THEN SIGNAL ContextProblem["Variable set twice", variable] 
ELSE Scheme.DefineVariable[variable, value, env];
};

InternalSet: PROC [env: Environment, variable: ATOM, value: Any] = {
IF NOT IsDefinedTopLevel[env, variable] 
THEN SIGNAL ContextProblem["Undefined variable", variable] 
ELSE [] _ Scheme.SetVariableValue[variable, value, env];
};

InternalGet: PROC [env: Environment, variable: ATOM] RETURNS [value: Any] = {
value _ Scheme.LookupVariableValue[variable, env];
};

InternalEval: PROC [env: Environment, expr: Core.ROPE] RETURNS [value: Any] = {
value _ Scheme.Eval[Scheme.ReadRope[expr, TRUE], env];
};

InternalDefineEval: PROC [env: Environment, variable: ATOM, expr: Core.ROPE] = {
InternalDefine[env, variable, InternalEval[env, expr]];
};

InternalSetEval: PROC [env: Environment, variable: ATOM, expr: Core.ROPE] = {
InternalSet[env, variable, InternalEval[env, expr]];
};

Narrow: PROC [context: Context] RETURNS [env: Environment] = {
env _ NARROW [context];
IF env.parent=NIL OR env.names#NIL OR env.values=NIL THEN SIGNAL PipalSinix.InternalBug[];
IF env.parent#initialEnvironment THEN SIGNAL PipalSinix.InternalBug[];
};

SchemeToCedar: PROC [value: Any] RETURNS [REF] = {
RETURN [WITH value SELECT FROM
string: Scheme.String	=> Scheme.RopeFromString[string],
ENDCASE	=> value];
};

CedarToScheme: PROC [value: REF] RETURNS [Any] = {
RETURN [WITH value SELECT FROM
rope: ROPE	=> Scheme.StringFromRope[rope],
ENDCASE	=> value];
};

CreateContext: PUBLIC PROC RETURNS [context: Context] = {
env: Environment _ NEW [Scheme.EnvironmentRep _ [
parent: initialEnvironment, names: NIL, values: RefTab.Create[], mark: 100,
id: Scheme.StringFromRope["PipalSisyph"]
]];
context _ env;
};

NewAssignmentContext: PROC [context: Context, assignments: LIST OF ParsedRope] RETURNS [Context] = {
env: Environment _ Narrow[context];
new: Environment  _ NEW [Scheme.EnvironmentRep _ [parent: env.parent, names: NIL, values: RefTab.Copy[NARROW [env.values]]]];
FOR list: LIST OF ParsedRope _ assignments, list.rest WHILE list#NIL DO
InternalSet[new, list.first.variable, InternalEval[env, list.first.expr]];
ENDLOOP;
RETURN [new];
};

NewDeclarationContext: PROC [context: Context, declarations: LIST OF ParsedRope] RETURNS [Context] = {
env: Environment _ Narrow[context];
new: Environment  _ NEW [Scheme.EnvironmentRep _ [parent: env.parent, names: NIL, values: RefTab.Create[]]];
FOR list: LIST OF ParsedRope _ declarations, list.rest WHILE list#NIL DO
variable: ATOM _ list.first.variable;
InternalDefine[new, variable, IF IsDefinedTopLevel[env, variable] THEN InternalGet[env, variable] ELSE InternalEval[env.parent, list.first.expr]];
ENDLOOP;
RETURN [new];
};

EvalProperties: PROC [context: Context, object: Object, properties: LIST OF ParsedRope, others: ROPES, props: Core.Properties] RETURNS [Core.Properties] = {
FOR list: LIST OF ParsedRope _ properties, list.rest WHILE list#NIL DO
key: ATOM _ list.first.variable;
value: REF _ Eval[context, list.first.expr];
oldValue: REF _ CoreProperties.GetProp[props, key];
IF oldValue#NIL AND oldValue#value THEN SIGNAL PipalSinix.FusionPropMismatch[object, key, oldValue, value];
props _ CoreProperties.PutProp[props, key, value];
ENDLOOP;
FOR list: ROPES _ others, list.rest WHILE list#NIL DO
props _ LayoutProcessName[object, list.first, props];
ENDLOOP;
RETURN [props];
};

Define: PUBLIC PROC [context: Context, variable: ATOM, value: REF] = {
InternalDefine[Narrow[context], variable, CedarToScheme[value]];
};

Set: PUBLIC PROC [context: Context, variable: ATOM, value: REF] = {
InternalSet[Narrow[context], variable, CedarToScheme[value]];
};

Get: PUBLIC PROC [context: Context, variable: ATOM] RETURNS [value: REF] = {
value _ SchemeToCedar[InternalGet[Narrow[context], variable]];
};

GetInt: PUBLIC PROC [context: Context, variable: ATOM] RETURNS [value: INT] = {
WITH Get[context, variable] SELECT FROM
refInt: REF INT	=> RETURN [refInt^];
refNat: REF NAT	=> RETURN [INT [refNat^]];
ENDCASE	=> SIGNAL PipalSinix.CallerBug[];
};

GetAtom: PUBLIC PROC [context: Context, variable: ATOM] RETURNS [value: ATOM] = {
value _ NARROW [Get[context, variable]];
};

GetRope: PUBLIC PROC [context: Context, variable: ATOM] RETURNS [value: Core.ROPE] = {
value _ Scheme.RopeFromString[NARROW [Get[context, variable]]];
};

Eval: PUBLIC PROC [context: Context, expr: Core.ROPE] RETURNS [value: REF] = {
value _ SchemeToCedar[InternalEval[Narrow[context], expr]];
};

DefineEval: PUBLIC PROC [context: Context, variable: ATOM, expr: Core.ROPE] = {
Define[context, variable, Eval[context, expr]];
};

SetEval: PUBLIC PROC [context: Context, variable: ATOM, expr: Core.ROPE] = {
Set[context, variable, Eval[context, expr]];
};
ContextProblem: PUBLIC SIGNAL [message: Core.ROPE, variable: ATOM] = CODE;

GlobalNonAtomic: PUBLIC SIGNAL [object: Object, name: ROPE, wire: Wire] = CODE;

InterpreterProblem: PUBLIC SIGNAL [context: Context, expr, errorRope: ROPE] = CODE;
ParseRope: PROC [rope: ROPE] RETURNS [tokenKind: IO.TokenKind, token, rest: ROPE] = {
ENABLE {
IO.Error => GOTO Error;
IO.EndOfStream => GOTO EOF;
};
stream: IO.STREAM _ IO.RIS[rope];
charsSkipped1: INT _ IO.SkipWhitespace[stream];
charsSkipped2: INT;
[tokenKind, token, charsSkipped2] _ IO.GetCedarTokenRope[stream];
rest _ Rope.Substr[rope, charsSkipped1+charsSkipped2+Rope.Length[token]];
EXITS 
Error => RETURN [tokenERROR, NIL, NIL];
EOF => RETURN [tokenEOF, NIL, NIL];
};

ParseSatellite: PUBLIC PROC [satellite: ROPE] RETURNS [variable: ATOM _ NIL, char: CHAR, expr: ROPE] = {
tokenKind1, tokenKind2: IO.TokenKind; token1, token2: ROPE;
[tokenKind1, token1, expr] _ ParseRope[satellite];
IF tokenKind1#tokenID THEN RETURN [NIL, '!, satellite];
[tokenKind2, token2, expr] _ ParseRope[expr];
IF tokenKind2#tokenSINGLE THEN RETURN [NIL, '!, satellite];
char _ Rope.Fetch[token2];
IF char#'~ AND char#'_ AND char#': THEN RETURN [NIL, '!, satellite];
variable _ Convert.AtomFromRope[token1];
};

ParseSatellites: PUBLIC PROC [satellites: ROPES] RETURNS [declarations, assignments, properties: LIST OF ParsedRope _ NIL, others: ROPES _ NIL] = {
WHILE satellites#NIL DO
variable: ATOM; char: CHAR; expr: ROPE;
[variable, char, expr] _ ParseSatellite[satellites.first];
IF variable=NIL 
THEN others _ CONS [satellites.first, others] ELSE SELECT char FROM 
'~	=> declarations _ CONS [[variable, expr], declarations];
'_	=> assignments _ CONS [[variable, expr], assignments];
':	=> properties _ CONS [[variable, expr], properties];
ENDCASE	=> SIGNAL PipalSinix.InternalBug[];
satellites _ satellites.rest;
ENDLOOP;
};

EqualRopes: PUBLIC PROC [ropes1, ropes2: ROPES] RETURNS [BOOL] = {
FOR r1: ROPES _ ropes1, r1.rest WHILE r1#NIL DO
IF NOT RopeList.Memb[ropes2, r1.first] THEN RETURN [FALSE];
ENDLOOP; 
FOR r2: ROPES _ ropes2, r2.rest WHILE r2#NIL DO
IF NOT RopeList.Memb[ropes1, r2.first] THEN RETURN [FALSE];
ENDLOOP; 
RETURN [TRUE];
};

EqualValues: PROC [value1, value2: REF] RETURNS [BOOL] = {
IF value1=value2 THEN RETURN [TRUE];
WITH value1 SELECT FROM 
rr1: ROPES	=> WITH value2 SELECT FROM
rr2: ROPES	=> RETURN [EqualRopes[rr1, rr2]];
ENDCASE	=> RETURN [FALSE];
r1: ROPE	=> WITH value2 SELECT FROM
r2: ROPE	=> RETURN [Rope.Equal[r1, r2]];
ENDCASE	=> RETURN [FALSE];
ri1: REF INT	=> WITH value2 SELECT FROM
ri2: REF INT	=> RETURN [ri1^=ri2^];
ri2: REF NAT	=> RETURN [ri1^=ri2^];
ENDCASE	=> RETURN [FALSE];
ri1: REF NAT	=> WITH value2 SELECT FROM
ri2: REF INT	=> RETURN [ri1^=ri2^];
ri2: REF NAT	=> RETURN [ri1^=ri2^];
ENDCASE	=> RETURN [FALSE];
ENDCASE	=> RETURN [FALSE];
};

IsSubset: PROC [a, b: RefTab.Ref] RETURNS [BOOL] = {
CheckAbsentInb: RefTab.EachPairAction = {
found: BOOL; bVal: RefTab.Val;
pair1, pair2: Scheme.Pair;
[found, bVal] _ RefTab.Fetch[b, key];
IF NOT found THEN RETURN [TRUE];
IF bVal=val THEN RETURN [FALSE];
pair1 _ NARROW [bVal]; pair2 _ NARROW [val];
IF pair1.car#pair2.car THEN SIGNAL PipalSinix.InternalBug[];
quit _ NOT EqualValues[pair1.cdr, pair2.cdr];
};
RETURN [NOT RefTab.Pairs[a, CheckAbsentInb]];
};

ObjectEqual: PROC [object: Object, context1, context2: Context] RETURNS [BOOL] = {
env1: Environment _ Narrow [context1];
env2: Environment _ Narrow [context2];
table1: RefTab.Ref _ NARROW [env1.values];
table2: RefTab.Ref _ NARROW [env2.values];
IF env1.parent#env2.parent THEN RETURN [FALSE];
RETURN [IsSubset[table1, table2] AND IsSubset[table2, table1]];
};
OrNames: PROC [object: Object, name1, name2: ROPE] RETURNS [name: ROPE _ NIL] = {
IF name1=NIL THEN RETURN [name2];
IF name2=NIL THEN RETURN [name1];
IF Rope.Equal[name1, name2] THEN RETURN [name1];
SIGNAL PipalSinix.FusionPropMismatch[object, CoreOps.nameProp, name1, name2];
};

LayoutProcessName: PROC [object: Object, name: ROPE, props: Core.Properties] RETURNS [Core.Properties] = {
name _ OrNames[object, name, NARROW [CoreProperties.GetProp[props, CoreOps.nameProp]]];
RETURN [CoreProperties.PutProp[props, CoreOps.nameProp, name]];
};

ExtractSats: PROC [object: Object, context: Context, satellites: ROPES, instance: BOOL] RETURNS [result: REF, props: Core.Properties] = {
declarations, assignments, properties: LIST OF ParsedRope; others: ROPES;
[declarations, assignments, properties, others] _ ParseSatellites[satellites];
IF instance THEN {
IF declarations#NIL THEN SIGNAL PipalSinix.CallerBug[];
IF assignments#NIL THEN context _ NewAssignmentContext[context, assignments];
[result, props] _ PipalSinix.Extract[object, mode, context];
IF result=NIL THEN RETURN; 
WITH result SELECT FROM
subWire: Wire 			=> {
wire: Wire _ CoreOps.CopyWire[subWire];
PipalCore.PutPort[mode.decoration, wire, object];
wire.properties _ EvalProperties[context, object, properties, others, wire.properties];
result _ wire;
};
subWires: Wires 		=> SIGNAL PipalSinix.CallerBug[]; -- what to do with that name!
subCellType: CellType	=> props _ EvalProperties[context, object, properties, others, props];
ENDCASE					=> SIGNAL PipalSinix.InternalBug[];
} ELSE {
IF assignments#NIL THEN SIGNAL PipalSinix.CallerBug[];
IF declarations#NIL THEN context _ NewDeclarationContext[context, assignments];
[result, props] _ PipalSinix.NonCachingExtract[object, mode, context];
IF result=NIL THEN RETURN; 
WITH result SELECT FROM
subWire: Wire 			=> subWire.properties _ EvalProperties[context, object, properties, others, subWire.properties];
subWires: Wires 		=> SIGNAL PipalSinix.CallerBug[]; -- what to do with that name!
subCellType: CellType	=>
subCellType.properties _ EvalProperties[context, object, properties, others, subCellType.properties];
ENDCASE					=> SIGNAL PipalSinix.InternalBug[];

};
};

ExtractAnnotation: PipalSinix.ExtractProc = {
annotation: Pipal.Annotation = NARROW [object];
SELECT annotation.key FROM
mode.extractAnnotationProp	=> {
atom: ATOM = NARROW [annotation.value];
proc: PipalSinix.ExtractProc _ PipalSinix.FetchExtractProc[atom];
IF proc=NIL THEN {
TerminalIO.PutF["*** ExtractProc $%g not registered.  You must run the program defining it.\n", IO.atom[atom]]; SIGNAL PipalSinix.CallerBug[];
};
[result, props] _ proc[annotation.child, mode, context];
};
Pipal.nameProp	=> {
name: ROPE _ NARROW [annotation.value];
[result, props] _ PipalSinix.NonCachingExtract[annotation.child, mode, context];
IF result=NIL THEN RETURN; 
WITH result SELECT FROM
subWire: Wire 			=>
subWire.properties _ LayoutProcessName[object, name, subWire.properties];
subWires: Wires 		=> SIGNAL PipalSinix.CallerBug[]; -- what to do with that name!
subCellType: CellType	=>
subCellType.properties _ LayoutProcessName[object, name, subCellType.properties];
ENDCASE					=> SIGNAL PipalSinix.InternalBug[];
};
instanceExpressionsProp	=> [result, props] _ ExtractSats[annotation.child, context, NARROW [annotation.value], TRUE];
objectExpressionsProp		=> [result, props] _ ExtractSats[annotation.child, context, NARROW [annotation.value], FALSE];
PipalMos.indirectProp		=> SIGNAL PipalSinix.CallerBug[];
ENDCASE	=> [result, props] _ PipalSinix.ExtractConnectized[object, mode, context];
};

ExtractStar: PipalSinix.ExtractProc = {
star: PipalMos.Star = NARROW [object];
[result, props] _ ExtractSats[star.master, context, PipalMos.GetNonItalicRopes[star], NOT star.overlayStar];
};

ExtractSchematicIcon: PipalSinix.ExtractProc = {
icon: PipalMos.SchematicIcon _ NARROW [object];
iconCT: CellType _ NARROW [PipalSinix.Extract[icon.child, mode, context].result];
result _ IF icon.code 
THEN Eval[context, icon.expression] 
ELSE Extract[icon.expression];
SELECT icon.type FROM
cell	=> {
cellType: CellType;
IF result=NIL THEN SIGNAL PipalSinix.CallerBug[];
cellType _ PipalSinix.CreateIcon[NARROW [result]];
PipalCore.PutObject[mode.decoration, cellType, object];
IF NOT CheckAndDecorate[object, iconCT.public, cellType.public] THEN {
TerminalIO.PutF["*** Error: icon public and schematic public do NOT conform\n"];
TerminalIO.PutF["Icon public is:"];
CoreOps.PrintWire[wire: iconCT.public, out: TerminalIO.TOS[], level: LAST [NAT]];
TerminalIO.PutF["\nSchematic public is:"];
CoreOps.PrintWire[wire: cellType.public, out: TerminalIO.TOS[], level: LAST [NAT]];
TerminalIO.PutF["\n"];
ERROR
};
result _ cellType;
};
wire, unnamedWire	=> {
FlushName: CoreOps.EachWireProc = {[] _ CoreOps.SetShortWireName[wire, NIL]};
resultWire: WireSeq;
IF result=NIL THEN {
result _ resultWire _ iconCT.public; 
IF icon.type = unnamedWire THEN [] _ CoreOps.VisitWireSeq[resultWire, FlushName];
RETURN;
};
WITH result SELECT FROM
wires: Wires		=> result _ resultWire _ CoreOps.CreateWire[wires]; 
ww: Wire			=> {result _ ww; resultWire _ CoreOps.CreateWire[LIST [ww]]};
cellType: CellType	=> {
IF props#NIL THEN ERROR;
result _ resultWire _ CoreOps.CopyWire[cellType.public]; 
};
ENDCASE			=> ERROR;
IF NOT CheckAndDecorate[object, iconCT.public, resultWire] THEN {
TerminalIO.PutF["*** Error: icon wire and result wire icon don't conform\n"];
TerminalIO.PutF["Icon wire is:"];
CoreOps.PrintWire[wire: iconCT.public, out: TerminalIO.TOS[], level: LAST [NAT]];
TerminalIO.PutF["\nResult wire is:"];
CoreOps.PrintWire[wire: resultWire, out: TerminalIO.TOS[], level: LAST [NAT]];
TerminalIO.PutF["\n"];
ERROR
};
IF icon.type = unnamedWire THEN [] _ CoreOps.VisitWireSeq[resultWire, FlushName];
};
ENDCASE	=> SIGNAL PipalSinix.CallerBug[];
};

ExtractSchematicSequence: PipalSinix.ExtractProc = {
seq: PipalMos.SchematicSequence _ NARROW [object];
value: REF INT _ NARROW [Eval[context, seq.repetition]];
count: NAT _ value^;
wholeCT, baseCT, sequence: CellType; 
internal, baseActual, basePublic: WireSeq;
baseInst: CoreClasses.RecordCellType;
sequenceWires, flatSequenceWires: Wires _ NIL;

[result, props] _ PipalSinix.Extract[seq.child, mode, context];
IF props#NIL THEN ERROR;
wholeCT _ NARROW [result];
baseInst _ NARROW [wholeCT.data];
internal _ baseInst.internal;
IF baseInst.size#1 THEN {
TerminalIO.PutF["*** ExtractSchematicSequence: Sequence should contain one and only one subcell.\n"];
ERROR};
baseCT _ baseInst[0].type; baseActual _ baseInst[0].actual; basePublic _ baseCT.public;
FOR i: NAT IN [0 .. internal.size) DO
wire: Wire = internal[i];
name: ROPE _ CoreOps.GetShortWireName[wire];
IF name=NIL THEN name _ "some wire";
IF NOT CoreOps.RecursiveMember[baseActual, wire] THEN {
TerminalIO.PutF["*** ExtractSchematicSequence: %g is not connected to subcell.\n", IO.rope[name]];
ERROR}; 
IF NOT CoreOps.RecursiveMember[wholeCT.public, wire] THEN {
TerminalIO.PutF["*** ExtractSchematicSequence: %g is not public.\n", IO.rope[name]];
ERROR}; 
ENDLOOP;
FOR i: NAT IN [0 .. basePublic.size) DO
IF CoreProperties.GetWireProp[baseActual[i], $Sequence]#NIL 
THEN sequenceWires _ CONS [basePublic[i], sequenceWires];
IF CoreProperties.GetWireProp[baseActual[i], $FlatSequence]#NIL 
THEN flatSequenceWires _ CONS [basePublic[i], flatSequenceWires];
ENDLOOP;
sequence _ CoreClasses.CreateSequence[
args: NEW [CoreClasses.SequenceCellTypeRec _ [
base: baseCT, count: count, 
sequence: FindPorts[basePublic, sequenceWires], 
flatSequence: FindPorts[basePublic, flatSequenceWires]
]],
name: CoreOps.GetCellTypeName[wholeCT], props: props
];
FOR i: NAT IN [0..sequence.public.size) DO
iconWire: Wire = CoreClasses.CorrespondingActual[baseInst[0], basePublic[i]];
PipalCore.PutPort[PipalCore.schematicsDecoration, sequence.public[i], iconWire];
PipalCore.PutGeometry[PipalCore.schematicsDecoration, sequence.public[i], PipalCore.GetGeometry[PipalCore.schematicsDecoration, iconWire]];
ENDLOOP;
PipalCore.PutObject[mode.decoration, sequence, object];
result _ sequence;
};

FindPorts: PROC [basePublic: WireSeq, wires: Wires] RETURNS [set: CoreClasses.SequenceSet] = {
nats: LIST OF NAT _ NIL;
size: NAT _ 0;
WHILE wires#NIL DO
FOR w: NAT IN [0 .. basePublic.size) DO
sequenceName: ROPE _ CoreOps.GetShortWireName[wires.first]; 
IF wires.first=basePublic[w] OR (sequenceName#NIL AND Rope.Equal[sequenceName, CoreOps.GetShortWireName[basePublic[w]]]) THEN {
nats _ CONS [w, nats]; size _ size + 1;
EXIT};
REPEAT FINISHED => ERROR;
ENDLOOP; 
wires _ wires.rest;
ENDLOOP;
set _ NEW [CoreClasses.SequenceSetRec[size]];
FOR i: INT IN [0 .. size) DO set[i] _ nats.first; nats _ nats.rest ENDLOOP;
};
CheckAndDecorate: PROC [object: Object, drawnPublic, resultPublic: WireSeq] RETURNS [ok: BOOL _ TRUE] = {
resultToDrawn: RefTab.Ref _ RefTab.Create[]; -- associates resultPublic to drawnPublic
FOR i: NAT IN [0 .. drawnPublic.size) DO
EachResultWire: CoreOps.EachWireProc = {
resultName: ROPE _ CoreOps.GetShortWireName[wire];
IF NOT Rope.Equal[resultName, drawnName] THEN RETURN;
IF wire=resultWire THEN RETURN;
IF resultWire#NIL THEN {TerminalIO.PutF["*** Drawn Icon has a wire %g whose name appears more than once in the schematic\n", IO.rope[drawnName]]; quit _ TRUE; ok _ FALSE; RETURN};
resultWire _ wire;
};
drawnWire: Wire _ drawnPublic[i];
drawnName: ROPE _ CoreOps.GetShortWireName[drawnWire];
resultWire: Wire _ NIL;
IF drawnName=NIL THEN {TerminalIO.PutF["*** Drawn Icon has an unnamed wire\n"]; ok _ FALSE; LOOP};
IF CoreOps.VisitWire[resultPublic, EachResultWire] THEN LOOP;
IF resultWire=NIL THEN {TerminalIO.PutF["*** Drawn Icon has wire %g that doesn't correspond to any wire in the schematic\n", IO.rope[drawnName]]; ok _ FALSE; LOOP};
PipalCore.PutPort[mode.decoration, resultWire, PipalCore.GetPort[mode.decoration, drawnWire]];
[] _ RefTab.Store[resultToDrawn, resultWire, drawnWire];
ENDLOOP;
FOR i: NAT IN [0 .. resultPublic.size) DO
resultWire: Wire _ resultPublic[i];
resultName: ROPE _ CoreOps.GetShortWireName[resultWire];
drawnWire: Wire _ NARROW [RefTab.Fetch[resultToDrawn, resultWire].val];
IF resultName=NIL THEN LOOP;
IF drawnWire#NIL THEN LOOP;
IF RopeList.Memb[globalNames, resultName] THEN LOOP;
TerminalIO.PutF["*** Warning: schematic has wire %g that corresponds to no wire in the drawn Icon\n", IO.rope[resultName]]; 
ENDLOOP;
};

ProcessGlobalName: PROC [object: Object, fused: RefTab.Ref, instances: LIST OF CoreClasses.CellInstance, name: ROPE] = {
global: Wire;
globals: Wires;
InsertGlobal: PROC [wire: Wire] = {
IF wire.size#0 THEN SIGNAL GlobalNonAtomic[object, name, wire];
IF NOT CoreOps.Member[globals, wire] THEN globals _ CONS [wire, globals];
};
FindGlobals: CoreOps.EachWirePairProc = {
act: Wire _ PipalSinix.RootWire[fused, actualWire];
actualName: ROPE = CoreOps.GetShortWireName[act];
IF NOT Rope.Equal[CoreOps.GetShortWireName[publicWire], name] THEN RETURN;
IF actualName=NIL OR Rope.Equal[actualName, name] THEN InsertGlobal[act];
};
EachWire: PROC [wire: Core.Wire] = {
IF Rope.Equal[CoreOps.GetShortWireName[wire], name] THEN InsertGlobal[wire];
};
FOR list: LIST OF CoreClasses.CellInstance _ instances, list.rest WHILE list#NIL DO
[] _ CoreOps.VisitBindingSeq[list.first.actual, list.first.type.public, FindGlobals];
ENDLOOP;
[] _ PipalSinix.EnumerateRoots[fused, EachWire];
IF globals=NIL THEN RETURN;
global _ CoreOps.SetShortWireName[globals.first, name];
CoreProperties.PutWireProp[global, $Public, $Public];
globals _ globals.rest;
WHILE globals#NIL DO
global _ PipalSinix.StructuredFusion[mode, object, fused, global, globals.first];
globals _ globals.rest;
ENDLOOP;
};

PostProcessFused: PipalSinix.PostProcessProc = {
FOR names: ROPES _ globalNames, names.rest WHILE names#NIL DO
ProcessGlobalName[object, fused, instances, names.first];
ENDLOOP;
PipalSinix.SchematicsFusionByName[mode, object, context, fused, instances];
};

ToCedar: PROC [primitive: Scheme.Primitive, arg1, arg2, arg3: Any, pl: Scheme.ProperList] RETURNS [result: Any] = {
result _ SchemeToCedar[arg1];
};
Pipal.PutClassMethod[Pipal.annotationClass, mode.extractMethod, NEW [PipalSinix.ExtractProc _ ExtractAnnotation]];
Pipal.PutClassMethod[PipalMos.starClass, mode.extractMethod, NEW [PipalSinix.ExtractProc _ ExtractStar]];
Pipal.PutClassMethod[PipalMos.schematicIconClass, mode.extractMethod, NEW [PipalSinix.ExtractProc _ ExtractSchematicIcon]];
Pipal.PutClassMethod[PipalMos.schematicSequenceClass, mode.extractMethod, NEW [PipalSinix.ExtractProc _ ExtractSchematicSequence]];

PipalSinix.schematicsMode _ mode;

Scheme.DefinePrimitive["cedar", 1, FALSE, ToCedar, "converts a Scheme argument to a Cedar argument", initialEnvironment];

END.

PipalSisyphImpl.mesa
Copyright Σ 1985, 1986, 1987, 1988 by Xerox Corporation.  All rights reserved.
Created by Sindhu and Serlet, November 27, 1985 9:11:39 pm PDT
Pradeep Sindhu June 25, 1987 4:59:16 pm PDT
Barth, October 15, 1986 10:25:34 am PDT
Bertrand Serlet, May 11, 1988 3:00:45 pm PDT
Jean-Marc Frailong December 12, 1987 5:41:02 pm PST
Christian Jacobi, July 15, 1986 6:24:40 pm PDT
Don Curry May 7, 1987 10:30:40 pm PDT
Types
All variables have values which are Scheme data types except the ones which are CellTypes, Wire, Wires or ROPES
Constants and Variables
Extraction Convenience
Context Handling Procedures
This one in Scheme?
Checks that a PipalSinix context is of the right form, i.e. a 2-level environement:  
- the parent is initialEnvironment, always invariant.
- the current environment contains the few current variables.
ENABLE ANY => SIGNAL InterpreterProblem[context, expr, NIL];
Exceptions
Parsing 
Context Equality and Caching
Added code to handle the special case of ROPE as well as ROPES
This one depends quite heavily on Scheme ...
Returns TRUE iff a is a subset of b
It is a potential parameter. Check if its there in the context and equal
ExtractProcs
Check public
special case
There should be only one subcell
we check that there is no internal only
We compute which wires are going to be sequenced
We create the sequence
Attention here: we copy only a few selected properties, because it is bad to have designers rely on the way the sequence is obtained (extracting the whole thing, thus gathering properties).  Moreover, if we copy all, things like the Sequence information will crap up, thus messing the level above (e.g. if it is a sequence itself).
The object decoration!
Utilities for the implementation
Construct the association by searching in resultPublic for every name found in drawnPublic
We decorate the resultWire with the pins of drawnWire
Ensure that each resultPublic corresponds to some iconic Wire (apart may be from the wires in globalNames).  Warning only for those.
Scheme Functions
Module Initialization

Κπ˜š
œ™Jš
œN™NIcodešœ;Οk™>Kšœ(™+Kšœ$™'Kš
œ,™,Kšœ0™3Kšœ+™.Kšœ"™%J˜—š
	˜	K˜	K˜+Kšœ
˜Kš
œK˜KKš
œ˜K˜Kš
œ˜—J˜šΟnœœ
œ˜"Jšœ0œl˜₯
Jšœ˜Jšœ˜Jšœ
œ˜—
head™Kšœ	œ˜#šœ
œ˜'Kšœj™o—Kšœœ˜Kšœ
œ˜Kšœœ
˜Kšœœ˜Kšœ	œ˜Kšœœœ
˜Kš
œœœ
œ
œ
˜Kšœœ˜—™Kšœœ
œœ%˜Lšœ
œ
œ˜/K˜—Kšœœ
œ˜Bšœœ
œ˜>K˜—šœœœ˜:Jš
œ+˜+J•StartOfExpansion[name: 
ROPE]š
œ;˜;Jš
œ(˜(Jšœ+Πbc Οc
˜LJš
œ˜Jš
œ"˜"J˜——™šžœœ
œœœ
œœœ˜dKš
œ#˜#Kš
œ+˜+Kš
œœ
œ>œœ˜gšœœ
œ*œœ
˜LKšœ%œœ˜CKšœ
˜—Kšœœ5˜CK˜——™š
œC˜CK˜—Kš
œ™š
žœœœœœ˜MKšœœ˜)Kšœ(˜.K˜K˜—šžœœœ˜Gšœ"˜$Kšœ
œ0˜;Kšœ-˜1—K˜K˜—šžœœœ˜Dšœ
œ"˜(Kšœ
œ0˜;Kšœ4˜8—K˜K˜—šžœœœœ˜MKš
œ2˜2K˜K˜—šžœœœœ˜OKšœ*œ˜6K˜K˜—šžœœœ
œ˜PKš
œ7˜7K˜K˜—šžœœœ
œ˜MKš
œ4˜4K˜K˜—š
œU™UKš
œ5™5K™=—šžœœœ˜>Kšœœ˜Kšœœ
œœ
œœ
œ
œ˜ZKšœœ
œ˜FK˜K˜—šž
œœœœ˜2šœœœ
˜Kš
œ7˜7Kšœ˜—K˜K˜—šž
œœ	œœ
˜2šœœœ
˜Kšœœ ˜*Kšœ˜—K˜K˜—šž
œœ
œ
œ˜9šœœ˜1Kšœ#œ%˜KKš
œ(˜(Kš
œ˜—K˜K˜K˜—š
žœœ!œ
œ
œ˜dJš
œ#˜#Jšœœ6œœ˜}šœœ
œ%œœ
˜GJš
œJ˜JJšœ
˜—Jšœ˜
J˜J˜—š
žœœ"œ
œ
œ˜fJš
œ#˜#Jšœœ6œ˜lšœœ
œ&œœ
˜HJšœ
œ˜%Jšœœ"œœ,˜’
Jšœ
˜—Jšœ˜
J˜J˜—šžœœ0œ
œœœ˜œ
šœœ
œ$œœ
˜FJšœœ˜ Jšœœ"˜,Jšœ
œ&˜3Jš
œ
œ
œœ
œ=˜kJš
œ2˜2Jšœ
˜—š	œœœœ
˜5Jš
œ5˜5Jšœ
˜—Jšœ	˜J˜J˜—š
žœœ
œœ	œ˜FKš
œ@˜@K˜K˜—š
žœœ
œœ	œ˜CKš
œ=˜=Kš
œ˜K˜—šžœœ
œœœ	œ˜LKš
œ>˜>K˜K˜—šžœœ
œœœ	œ˜Ošœœ
˜'Jšœœ
œœ˜$Jš	œœ
œœœ˜*Jšœœ˜)—J˜K˜—šžœœ
œœœ	œ˜QJšœœ˜(J˜K˜—šžœœ
œœœœ˜VJšœœ˜?Kš
œ˜K˜—šžœœ
œœœ	œ˜NKš
ΠbkΟb
‘’‘’œ’‘’™<Kš
œ;˜;K˜K˜—š
ž
œœ
œœ
œ˜OKš
œ/˜/K˜K˜—š
žœœ
œœ
œ˜LKš
œ,˜,K˜——™
šžœœ
œœœœ
˜JK˜—š
žœœ
œœœ
˜OK˜—Kš
žœœ
œ%œœ
˜S—™šž	œœœœ
œœ˜Ušœ˜Kšœ
œ˜Kšœœ
œ
˜K˜—Kš	œœ
œœ
œ˜!Kšœœœ˜/Kšœœ
˜Kšœ$œ˜AKš
œI˜Išœ
˜Kšœ	œœœ˜'Kšœœœœ˜#—K˜K˜—šžœœ
œ
œœœœœœ˜hKšœœœ
˜;Kš
œ2˜2Kšœœ
œœ˜7Kš
œ-˜-Kšœœ
œœ˜;Kš
œ˜Kšœ	œ	œ	œ
œœ˜DKš
œ(˜(K˜K˜—šžœœ
œœœ)œ
œœ
œœ˜“
šœœ
˜Kšœ
œœœ
˜'Kš
œ:˜:šœ
œ
˜š
œ
œœ
œœ
˜DKšœœ"˜;Kšœœ!˜9Kšœœ ˜7Kšœœ˜+——Kš
œ˜Kšœ
˜—K˜K˜——™šž
œœ
œœœœ˜Bš	œœœœ
˜/Kš
œ
œ!œ
œœ˜;Kšœ˜	—š	œœœœ
˜/Kš
œ
œ!œ
œœ˜;Kšœ˜	—Kšœœ˜K˜K˜—š
žœœœœœ˜:Kšœ)œ™>Kšœœ
œœ˜$šœœ
œ
˜šœœœœ
˜%Kšœœœ˜,Kšœœœ˜—šœœœœ
˜#Kšœœœ˜(Kšœœœ˜—š
œœ
œœœ
˜'Kšœœ
œœ
˜#Kšœœ
œœ
˜#Kšœœœ˜—š
œœ
œœœ
˜'Kšœœ
œœ
˜#Kšœœ
œœ
˜#Kšœœœ˜—Kšœœœ˜—K˜K˜—K™,Kšœœ™#šžœœœœ˜4šžœ˜)Kšœœ˜Kš
œ˜K™HK˜%Kš
œ
œœ
œœ˜ Kšœ
œ
œœ˜ Kšœœœ˜,Kšœœ
œ˜<Jšœœ#˜-K˜—Kšœœ"˜-Kš
œ˜K˜—šžœœ/œœ˜RKš
œ&˜&Kš
œ&˜&Kšœœ˜*Kšœœ˜*Kšœœ
œœ˜/Kšœœ˜?Kš
œ˜——š
œ™šžœœ œœœœ˜QJšœœ
œ
œ	˜!Jšœœ
œ
œ	˜!Jšœœ
œ	˜0JšœG˜MJ˜J˜—šžœœœœ˜jJšœœ4˜WJšœ9˜?J˜J˜—šžœœ0œœœ
œ˜‰
Jšœ'œ
œœ
˜IJš
œN˜Nšœ
œ˜Jšœœ
œ
œ˜7Jšœ
œ
œ6˜MJš
œ<˜<Jšœœ
œ
œ˜šœœ
˜š
œ˜Jš
œ'˜'Jš
œ1˜1Jš
œW˜WJ˜J˜—Jšœœ ˜QJš
œ\˜\Jšœœ˜/—Jšœœ˜Jšœ
œ
œ
œ˜6Jšœœ
œ7˜OJš
œF˜FJšœœ
œ
œ˜šœœ
˜Jš
œq˜qJšœœ ˜Qš
œ˜Jš
œe˜e—Jšœœ˜/—J˜J˜—J˜J˜—šžœ˜-Jšœœ
˜/šœ˜š
œ˜Jšœœœ˜'Jš
œA˜Ašœœ
œ˜Jšœ`œœ˜Ž
J˜—Jš
œ8˜8J˜—š
œ˜Jšœœœ˜'Jš
œP˜PJšœœ
œ
œ˜šœœ
˜š
œ˜Jš
œI˜I—Jšœœ ˜Qš
œ˜Jš
œQ˜Q—Jšœœ˜/—J˜—JšœTœœ˜uJšœSœœ˜uJšœœ˜8Jšœ4’œ˜R—J˜J˜—šžœ˜'Jšœœ
˜&JšœVœ˜lJ˜J˜—šžœ˜0Jšœœ
˜/Jšœœ8˜Qšœ	œ˜Jšœ ˜$Jšœ˜—šœ˜š
œ	˜	Jš
œ˜Jšœœ
œ
œ˜1Jšœ!œ˜2Jš
œ7˜7J™šœ
œ:œ˜FJš
œP˜PJš
œ#˜#Jšœ7œœœ˜QJš
œ*˜*Jšœ9œœœ˜SJš
œ˜Jš
˜J˜—Jš
œ˜J˜—š
œ˜Jšž	œ>œ˜MJ˜šœœ
œ˜Jš
œ%˜%Jšœœ2˜QJšœ
˜Jš
œ˜—šœœ
˜Jš
œB˜BJšœ<œ˜Hš
œ˜Jšœœ
œ
‘œ
˜Jš
œ9˜9J˜—Jšœœ
˜—Jš
œ™šœ
œ5œ˜AJš
œM˜MJš
œ!˜!Jšœ7œœœ˜QJš
œ%˜%Jšœ4œœœ˜NJš
œ˜Jš
˜J˜—Jšœœ2˜QJ˜—Jšœœ˜)—Jš
œ˜J˜—šžœ˜4Jšœ"œ
˜2Jšœœ
œœ!˜8Jšœœ
˜Jš
œ%˜%Jš
œ*˜*Jš
œ%˜%Jšœ*œ
˜.J˜Jš
œ?˜?Jšœœ
œ
œ
˜Jšœ
œ
˜Jšœœ˜!Jš
œ˜Jš
œ ™ šœœ˜Jš
œe˜eJšœ˜—Jš
œW˜WJš
œ'™'šœœ
œ˜%Jš
œ˜Jšœœ"˜,Jšœœ
œ˜$šœ
œ+œ˜7JšœSœ
˜bJšœ˜—šœ
œ/œ˜;JšœEœ
˜TJšœ˜—Jšœ
˜—Jš
œ0™0šœœ
œ˜'šœ6œ
˜<Jšœœ ˜9—šœ:œ
˜@Jšœœ$˜A—Jšœ
˜—Jš
œ™š
œ&˜&šœœ%˜.Jš
œ˜Jš
œ0˜0Jš
œ6˜6Jš
œ˜—Jš
œ4˜4Jš
œ˜—J™Λšœœ
œ˜*Jš
œM˜MJš
œP˜PJš
œ‹
˜‹
Jšœ
˜—J™Jš
œ7˜7Jš
œ˜Jš
œ˜J˜—šž	œœ%œ#˜^Jš	œœ
œ
œœ
˜Jšœœ˜šœœ
˜šœœ
œ˜'Jšœœ*˜<š
œœœ
œDœ˜Jšœœ˜'Jšœ˜—Jšœ
œœ
˜Jšœ˜	—Jš
œ˜Jšœ
˜—Jšœœ$˜-Jš	œœ
œ
œ'˜KJš
œ˜——™ š
Πbnœœ6œœœ˜iKšœ- )˜VKš
œZ™Zšœœ
œ˜(šžœ˜(Kšœœ"˜2Kšœ
œ#œ
œ
˜5Kšœœ
œ
˜Kšœœ
œgœœœœ˜³
Kš
œ˜K˜—Jš
œ!˜!Kšœœ'˜6Kšœœ
˜Jš
œœ
œ@œœ˜bKšœ1œ
œ
˜=Kšœœ
œgœœœ˜€
Kš
œ5™5Kš
œ^˜^Kš
œ8˜8Jšœ
˜—Kš
œ„
™„
šœœ
œ˜)Jš
œ#˜#Kšœœ(˜8Kšœœ/˜GJšœœ
œ
œ
˜Jšœœ
œ
œ
˜Jšœ(œ
œ
˜4Jšœfœ˜|Jšœ
˜—K˜K˜—š
žœœ0œ
œ!œ˜xJš
œ
˜
Jš
œ˜šžœœ˜#Jšœ
œ
œ%˜?Jšœ
œœœ˜IJ˜—šžœ˜)Jš
œ3˜3Jšœœ!˜1Jšœ
œ8œ
œ
˜JJšœœ
œœ˜IJ˜—šžœœ˜$Jšœ2œ˜LJ˜—šœœ
œ1œœ
˜SJš
œU˜UJšœ
˜—Jš
œ0˜0Jšœ	œ
œ
œ
˜Jš
œ7˜7Jš
œ5˜5Jš
œ˜šœ	œ
˜Jš
œQ˜QJ˜Jšœ
˜—J˜J˜—šžœ ˜0š	œœœœ
˜=Jš
œ9˜9Jšœ
˜—Jš
œK˜KJ˜J˜——™šžœœMœ˜sKš
œ˜K˜——™Kšœ@œ/˜rKšœ=œ)˜iKšœFœ2˜{šœJœ6˜ƒ
K˜—Kš
œ!˜!K˜Kšœ#œQ˜yK˜—šœ
˜J˜—K™—…—Zš}ž