This module is concerned with converting selected constraints and actions from the current image into an equivalent Juno S-expression.

JunoStorage USING
[Constr, Point, Coords, Frame, Action, Cons, GcList, HorConstr, VerConstr,
ParaConstr, PerpConstr, CongConstr, AtConstr, CcwConstr],
JunoBody,
JunoAlgebra USING
[Se, Value, ValueList, comma, leftPren, semicolon, hor, ver, para, perp, cong,
at, ccw, rel, print, draw, font, face, size, justified, true, skip, suchThat,
if, approx, and, rightArrow],
JunoMatrix USING [Matrix, MapCoords, InvertMatrix, GetFrameMatrix],
Rope USING [ROPE],
JunoImage USING
[EnumPoints, EnumConstrs, EnumActions, PointVisitProc,
ConstrVisitProc, ActionVisitProc, ActionIsWound, ConstrIsWound];

IMPORTS

EXPORTS JunoBody =

JunoBody,
Stor: JunoStorage,
Alg: JunoAlgebra,
Mat: JunoMatrix,
Im: JunoImage;

Value: TYPE = Alg.Value;

m: REF Mat.Matrix ← NEW[Mat.Matrix];

mInv: REF Mat.Matrix ← NEW[Mat.Matrix];

SingularFrame: ERROR = CODE;

MakeBody: PUBLIC PROC [frame: Frame] RETURNS [body: Se] =

BuildCoordsExpr: PROC [coords: Coords] RETURNS [expr: Se] =

BuildLocalList: PROC [frame: Frame, mInv: REF Mat.Matrix] RETURNS [locals: Se] =

ReverseAndNest: PROC [args: LIST OF Se, op: Se, zero: Se] RETURNS [expr: Se] =

BuildConstrList: PROC [frame: Frame] RETURNS [constrs: Se] =

BuildActionList: PROC RETURNS [actions: Se] =

Nest: PUBLIC PROC [list: LIST OF Se, op, zero: ATOM] RETURNS [Se] =

UnEval: PROC [arg: Alg.Value] RETURNS [expr: Se] =

UnEvalList: PROC [list: LIST OF Alg.Value] RETURNS [expr: Se] =

Pren2: PROC [v1, v2: Value] RETURNS [expr: Se] =

Pren3: PROC [v1, v2, v3: Alg.Value] RETURNS [expr: Se] =

PrenArgs: PROC [arg: LIST OF Alg.Value] RETURNS [expr: Se] =

MakeFrameExpr: PROC [frame: Frame] RETURNS [expr: Se] =

InsertPoint: PROCEDURE[p:PointPtr] =
BEGIN
temp: PointPtr ← pointLpad;
WHILE temp.link.x < p.x DO temp ← temp.link ENDLOOP;
p.link ← temp.link;
temp.link ← p;
END;

SortPoints: PUBLIC PROC =
{p,q,r, temp: PointPtr;
IF pointLpad = pointRpad THEN RETURN;
p ← pointLpad.link;
q ← p.link;
p.link ← pointLpad;
UNTIL q = pointRpad DO
IF q.x >= p.x THEN {temp ← q.link; q.link ← p; p ← q; q ← temp; LOOP};
-- Insert q into list p, link[p], link[link[p]], which is sorted in DESCENDING order.
r ← p;
WHILE r.link.x > q.x DO r ← r.link ENDLOOP;
temp ← q.link;
q.link ← r.link;
r.link ← q;
q ← temp;
ENDLOOP;
-- Now reverse the list by moving backwards through it:
UNTIL p = pointLpad DO temp ← p.link; p.link ← q; q ← p; p ← temp; ENDLOOP;
pointLpad.link ← q};

Distance: PROCEDURE[x1, y1, x2, y2: REAL] RETURNS [REAL] =
-- this procedure returns the distance between the points (x1,y1)
-- and (x2,y2).
BEGIN RETURN [RealFns.SqRt[(x1-x2)*(x1-x2) + (y1-y2)*(y1-y2)]] END;

FindSelectedPoint: PUBLIC PROCEDURE [x,y:REAL] RETURNS [PointPtr] =
-- This procedure finds the selected point closest to the current mouse coordinates.
-- It is identical to FindPoint except that slink replaces link. This is a good
-- example of why field selectors should be values.
BEGIN
leftpad: PointPtr = pointLpad;
rightpad: PointPtr = pointRpad;
p, champ: PointPtr;
champdistance, pdistance: REAL;
p ← leftpad.slink;
IF p = rightpad THEN RETURN[NIL];
champ ← p;
champdistance ← Distance[p.x, p.y, x, y];
p ← p.slink;
WHILE p # rightpad DO
pdistance ← Distance[p.x, p.y, x, y];
IF pdistance < champdistance THEN BEGIN champ ← p; champdistance ← pdistance END;
p ← p.slink;
ENDLOOP;
RETURN [champ];
END;

Now the procedures that are invoked as commands:

The move, copy, and delete commands operate on groups, and the former two involve
-- linear transformations, so before giving their code, we give the program that
-- inverts a matrix. It sets "singular" to TRUE if the matrix is singular.

m, m1, mInv: ARRAY [1..3] OF ARRAY [1..3] OF REAL;
singular: PUBLIC BOOLEAN;

Invertm: PROC =
-- Inverts m into mInv by pivoting three times; or sets "singular" flag.
BEGIN
i, j, k, l: INTEGER;
c: ARRAY [1..3] OF INTEGER;
pivoted: ARRAY [1..3] OF BOOLEAN ← [FALSE, FALSE, FALSE];
p: REAL;
-- k is the row in which we are pivoting.
-- l is the column in which we are pivoting.
-- i and j are miscellaneous row and column indices respectively
-- c[i] is the column of the pivot in the ith row.
-- p is the reciprocal of the pivot element; also used as temp for swapping.

singular ← FALSE;
FOR k IN [1..3] DO
-- set l so m[k,l] is largest of m[k,1], m[k, 2], m[k, 3], excluding
-- columns in which we have already pivoted.
p ← 0;
FOR j IN [1 .. 3]
DO IF ABS[m[k][j]] >= p AND NOT pivoted[j] THEN {l ← j; p ← ABS[m[k][l]]} ENDLOOP;
-- We will pivot at m[k,l], if it is not too small:
IF ABS[m[k][l]] < .0001 THEN {singular ← TRUE; RETURN};
c[k] ← l; pivoted[l] ← TRUE;
p ← 1.0 / m[k][l]; m[k][l] ← 1.0;
-- divide everything in pivot row by the pivot element:
FOR j IN [1..3] DO m[k][j] ← m[k][j] * p ENDLOOP;

FOR i IN [1..3] DO
IF i # k THEN
  FOR j IN [1..3] DO
  IF j # l THEN -- for each m[i,j] outside the pivot row and column
  m[i][j] ← m[i][j] - m[i][l] * m[k][j]; -- note that m[k,j] was already * p.
ENDLOOP ENDLOOP;

-- Finally process pivot column:
FOR i IN [1..3] DO IF i # k THEN m[i][l] ← -m[i][l] * p ENDLOOP;


ENDLOOP;

-- Now we permute rows and columns:

FOR i IN [1..3] DO FOR j IN [1..3] DO mInv[c[i]][j] ← m[i][c[j]] ENDLOOP ENDLOOP;

END;

MultiplyMatrix: PROCEDURE =
-- multiply m1 * mInv to produce m.
BEGIN
i, j, k: INTEGER;
sum: REAL;
FOR i IN [1..3] DO FOR j IN [1..3] DO
{sum ← 0.0; FOR k IN [1..3] DO sum ← sum + m1[i][k] * mInv[k][j] ENDLOOP;
m[i][j] ← sum}
ENDLOOP ENDLOOP;
END;

Identify: PUBLIC PROC[] =
-- replace all occurences of p by p.copy if p.copy # NIL.
{r, rr: PointPtr;
ScanLists[operation:move];
r ← pointLpad;
UNTIL r = pointRpad DO
IF r.link.copy # NIL THEN {rr ← r.link; r.link ← rr.link; GcPoint[rr]}
ELSE r ← r.link;
ENDLOOP};

MakeDefBody: PUBLIC PROC[orig, xaxis: PointPtr] RETURNS [REF]
= {IF xaxis = NIL THEN RETURN[OtherMakeDefBody[orig]] ELSE
{m[1][1] ← orig.x;
m[2][1] ← orig.y;
m[1][2] ← xaxis.x;
m[2][2] ← xaxis.y;

m1[1][1] ← 0;
m1[2][1] ← 0;
m1[1][2] ← 1;
m1[2][2] ← 0;

m[1][3] ← m[1][1] + m[2][1] - m[2][2];
m[2][3] ← m[2][1] + m[1][2] - m[1][1];
FOR j: INT IN [1..3] DO m[3][j] ← 1.0; m1[3][j] ← 1.0 ENDLOOP;
m1[1][3] ← m1[1][1] + m1[2][1] - m1[2][2];
m1[2][3] ← m1[2][1] + m1[1][2] - m1[1][1];

Invertm[];
IF singular THEN ERROR;
MultiplyMatrix[];

{p:PointPtr ← pointLpad.link;
WHILE p # pointRpad DO p.name ← NIL; p ← p.link ENDLOOP};

BuildLocalList[orig, xaxis];
BuildActionAndPredLists[];
{locals: REF ← IF localList = NIL THEN NIL ELSE Fix[localList, comma];
actions: REF ← IF actionList = NIL THEN $Skip ELSE Fix[actionList, semicolon];
preds: REF;
IF predList = NIL THEN preds ← $T ELSE preds ← Fix[predList, $and];
IF locals = NIL
THEN RETURN[actions]
ELSE
RETURN [LIST[$if, LIST[arrow, LIST[st, locals, preds], actions]]]}}};

OtherMakeDefBody: PROC[orig: PointPtr] RETURNS [REF] =
{p:PointPtr ← pointLpad.link;
WHILE p # pointRpad DO p.name ← NIL; p ← p.link ENDLOOP;
BuildLocalList[orig, NIL];
BuildActionAndPredLists[];
{locals: REF ← IF localList = NIL THEN NIL ELSE Fix[localList, comma];
actions: REF ← IF actionList = NIL THEN $Skip ELSE Fix[actionList, semicolon];
preds: REF;
IF predList = NIL THEN preds ← $T ELSE preds ← Fix[predList, $and];
IF locals = NIL
THEN RETURN[actions]
ELSE
RETURN [LIST[$if, LIST[arrow, LIST[st, locals, preds], actions]]]}};

arrow: ATOM = Atom.MakeAtom["->"];
st: ATOM = Atom.MakeAtom["|"];
comma: ATOM = Atom.MakeAtom[","];
semicolon: ATOM = Atom.MakeAtom[";"];
approx: ATOM = Atom.MakeAtom["=="];
leftpren: ATOM = Atom.MakeAtom["("];

Fix: PROC [rr: REF, op: REF] RETURNS [REF] =
{r: LIST OF REF ← NARROW[rr];
IF r.rest = NIL
THEN RETURN [r.first]
ELSE RETURN [LIST[op, r.first, Fix[r.rest, op]]]};

localList: LIST OF REF;
actionList: LIST OF REF;
predList: LIST OF REF;

BuildLocalList: PROC [orig, xaxis: PointPtr] =
{i: INT ← 2;
p: PointPtr ← pointLpad.slink;
x, y: REAL;
localList ← NIL;
UNTIL p = pointRpad DO
IF p = orig THEN p.name ← $a
ELSE IF p = xaxis THEN p.name ← $b
ELSE
{a: ATOM;
IF i > 25
THEN a ← Atom.MakeAtom[Rope.Cat["a", Convert.RopeFromInt[i - 26, 10, FALSE]]]
ELSE a ← Atom.MakeAtom[Rope.FromChar['a + i]];
p.name ← a;
i ← i + 1;
IF xaxis # NIL
THEN
{x ← p.x * m[1][1] + p.y * m[1][2] + m[1][3];
y ← p.x * m[2][1] + p.y * m[2][2] + m[2][3];
localList ← CONS[
LIST[approx, a, LIST[$rel, LIST[leftpren,
       LIST[comma, NEW[REAL ← x], NEW[REAL ← y]]],
     LIST[leftpren, LIST[comma, $a, $b]]]],
localList]}
ELSE
{x ← p.x - orig.x;
y ← p.y - orig.y;
localList ← CONS[
LIST[approx, a, LIST[$rel, LIST[leftpren,
       LIST[comma, NEW[REAL ← x], NEW[REAL ← y]]],
     LIST[leftpren, $a]]],
localList]}};
JunoGraphics.DrawRope[Atom.GetPName[NARROW[p.name]], p.x + 5, p.y + 5];
JunoGraphics.viewerChanged ← TRUE;
p ← p.slink
ENDLOOP};

BuildActionAndPredLists: PROC =
{actionList ← NIL;
predList ← NIL;
ScanLists[operation: build]};

copiedPoints: PUBLIC PointPtr;

Copy: PUBLIC PROCEDURE =
BEGIN
p, lastnew: PointPtr;
-- copy the list of selected points into a new list firstnew,
-- firstnew.slink ....
copiedPoints ← NewPoint[];
lastnew ← copiedPoints;
p ← pointLpad.slink;
p.copy ← copiedPoints;
copiedPoints.x ← p.x;
copiedPoints.y ← p.y;
copiedPoints.visible ← p.visible;
InsertPoint[copiedPoints];
p ← p.slink;
UNTIL p = pointRpad DO
lastnew.slink ← NewPoint[];
lastnew ← lastnew.slink;
p.copy ← lastnew;
lastnew.x ← p.x;
lastnew.y ← p.y;
copiedPoints.visible ← p.visible;
InsertPoint[lastnew];
p ← p.slink;
ENDLOOP;
lastnew.slink ← pointRpad;
ScanLists[operation: copy]; -- scan all edges, arcs, constraints and copy
-- any of them that involve copied points.
END;

ComputeTransform: PUBLIC PROC[a,b,c,sa,sb,sc:PointPtr] =
{-- we want m [ sa, sb, sc ] = [ a, b, c], where the points are viewed as
-- column vectors with third component 1. Hence we compute the inverse
-- of [sa, sb, sc] and multipy on the left by [a, b, c]. But the pairs
-- (b, sb), (c, sc) may be missing, in which case they are filled in by default to make
-- the transformation a translation (if both are missing) or a Euclidean motion
-- (if just (c, sc) is missing).
j: INTEGER;
FOR j IN [1..3] DO m[3][j] ← 1.0; m1[3][j] ← 1.0 ENDLOOP;

m[1][1] ← sa.x;
m[2][1] ← sa.y;
m1[1][1] ← a.x;
m1[2][1] ← a.y;

IF b # NIL AND sb # NIL THEN
{m[1][2] ← sb.x;
m[2][2] ← sb.y;
m1[1][2] ← b.x;
m1[2][2] ← b.y;}
ELSE
{m[1][2] ← sa.x + 300;
m[2][2] ← sa.y;
m1[1][2] ← a.x + 300;
m1[2][2] ← a.y};

IF c # NIL AND sc # NIL THEN
{m[1][3] ← sc.x;
m[2][3] ← sc.y;
m1[1][3] ← c.x;
m1[2][3] ← c.y}
ELSE
{m[1][3] ← m[1][1] + m[2][1] - m[2][2];
m[2][3] ← m[2][1] + m[1][2] - m[1][1];
m1[1][3] ← m1[1][1] + m1[2][1] - m1[2][2];
m1[2][3] ← m1[2][1] + m1[1][2] - m1[1][1]};

Invertm[];
IF singular THEN RETURN;
MultiplyMatrix[]}; -- end of ComputeTransform.

PerformTransform: PUBLIC PROCEDURE[p: PointPtr] =
{x, y: REAL;
UNTIL p = pointRpad DO
x ← p.x * m[1][1] + p.y * m[1][2] + m[1][3];
y ← p.x * m[2][1] + p.y * m[2][2] + m[2][3];
p.x ← x;
p.y ← y;
p ← p.slink;
ENDLOOP};

The move, copy and delete commands all involve scanning the lists of edges,
-- arcs, and constraints; this scan is done by one procedure (ScanLists) which
-- takes as an argument one of the four distinguished values copy, delete, move, mark:

Operation: TYPE = {copy, delete, move, mark, build};

AddAction: PROC[op: REF, r1: REF ← NIL, r2: REF ← NIL] =
{IF r2 = NIL
THEN actionList ← CONS[LIST[op, r1], actionList]
ELSE actionList ← CONS[LIST[op, r1, r2], actionList]};

Args: PROC [l: LIST OF PointPtr] RETURNS [REF] =
{IF l.rest = NIL
THEN RETURN [ArgName[l.first]]
ELSE RETURN [LIST[comma, ArgName[l.first], Args[l.rest]]]};

NewArgs: PROC [l: LIST OF REF] RETURNS [REF] =
{IF l.rest = NIL
THEN RETURN [ArgName[l.first]]
ELSE RETURN [LIST[comma, ArgName[l.first], NewArgs[l.rest]]]};

ArgName: PROC [r: REF] RETURNS [REF] =
{ WITH r SELECT FROM
rp: PointPtr => RETURN[rp.name];
ri: REF INT => RETURN[ri];
rr: Rope.ROPE => RETURN[rr];
ra: ATOM => RETURN[ra]
ENDCASE => ERROR };

PrenArgs: PROC [l: LIST OF PointPtr] RETURNS [REF] =
{RETURN [LIST[leftpren, Args[l]]]};

AddPred: PROC[op: REF, r1: REF ← NIL, r2: REF ← NIL] =
{IF r2 = NIL
THEN predList ← CONS[LIST[op, r1], predList]
ELSE predList ← CONS[LIST[op, r1, r2], predList]};

ScanLists: PROC[operation:Operation] =
BEGIN
{ -- scan the edges:
p: EdgePtr ← edgeLpad.link;
q: EdgePtr ← edgeLpad;
r: EdgePtr;

UNTIL p = edgeRpad DO
SELECT operation FROM

move => {IF p.b1.copy # NIL THEN p.b1 ← p.b1.copy;
  IF p.b2.copy # NIL THEN p.b2 ← p.b2.copy;
   p ← p.link};
  
 copy => {IF p.b1.copy # NIL AND p.b2.copy # NIL
  THEN {r ← NewEdge[];
   r.b1 ← p.b1.copy; r.b2 ← p.b2.copy;
    r.link ← edgeLpad.link; edgeLpad.link ← r};
   p ← p.link};
   
delete => IF p.b1.copy # NIL AND p.b2.copy # NIL
THEN {q.link ← p.link; GcEdge[p]; p ← q.link}
   ELSE {q ← p; p ← p.link};
  
mark => {p.b1.copy ← NIL; p.b2.copy ← NIL; p ← p.link};

build => {IF p.b1.name # NIL AND p.b2.name # NIL THEN
    AddAction[$draw, PrenArgs[LIST[p.b1, p.b2]]];
    p ← p.link}
 
ENDCASE => ERROR;
ENDLOOP};

{-- scan the arcs:
p: ArcPtr ← arcLpad.link;
q: ArcPtr ← arcLpad;
r: ArcPtr;

UNTIL p = arcRpad DO
SELECT operation FROM

move => {IF p.b1.copy # NIL THEN p.b1 ← p.b1.copy;
  IF p.b2.copy # NIL THEN p.b2 ← p.b2.copy;
   IF p.b3.copy # NIL THEN p.b3 ← p.b3.copy;
   IF p.b4.copy # NIL THEN p.b4 ← p.b4.copy;
   p ← p.link};
  
 copy => {IF p.b1.copy # NIL AND p.b2.copy # NIL
  AND p.b3.copy # NIL AND p.b4.copy # NIL
  THEN {r ← NewArc[];
   r.b1 ← p.b1.copy; r.b2 ← p.b2.copy;
    r.b3 ← p.b3.copy; r.b4 ← p.b4.copy;
    r.link ← arcLpad.link; arcLpad.link ← r};
   p ← p.link};
   
delete => IF p.b1.copy # NIL AND p.b2.copy # NIL
AND p.b3.copy # NIL AND p.b4.copy # NIL
THEN {q.link ← p.link; GcArc[p]; p ← q.link}
   ELSE {q ← p; p ← p.link};
  
mark => {p.b1.copy ← NIL; p.b2.copy ← NIL; p.b3.copy ← NIL; p.b4.copy ← NIL; p ← p.link};
 
  build => {IF p.b1.name # NIL AND p.b2.name # NIL
  AND p.b3.name # NIL AND p.b4.name # NIL
  THEN AddAction[$draw, PrenArgs[LIST[p.b1, p.b2, p.b3, p.b4]]];
  p ← p.link}
 
ENDCASE => ERROR;
ENDLOOP};

{ -- scan the strings:
p : StringPtr ← stringLpad.link;
q : StringPtr ← stringLpad;
r : StringPtr;

UNTIL p = stringRpad DO
SELECT operation FROM
move => {IF p.b3.copy # NIL THEN p.b3 ← p.b3.copy;
IF p.b4.copy # NIL THEN p.b4 ← p.b4.copy;
p ← p.link};

copy => {IF p.b3.copy # NIL AND p.b4.copy # NIL
THEN {r ← NewString[];
r.b3 ← p.b3.copy; r.b4 ← p.b4.copy;
r.stringText ← p.stringText;
r.fontName ← p.fontName;
r.fontSize ← p.fontSize;
r.bold ← p.bold;
r.italic ← p.italic;
r.height ← p.height; r.width ← p.width; r.depth ← p.depth;
  r.link ← stringLpad.link; stringLpad.link ← r};
p ← p.link};

delete => IF p.b3.copy # NIL AND p.b4.copy # NIL
THEN {q.link ← p.link; GcString[p]; p ← q.link}
ELSE {q ← p; p ← p.link};

mark => {p.b3.copy ← NIL; p.b4.copy ← NIL;
p ← p.link };

build => {Pack: PROC[b, i: BOOL] RETURNS [r:INT] =
    {r ← 0;
     IF i THEN r ← r + 1;
     IF b THEN r ← r + 2};
IF p.b3.name # NIL
THEN AddAction
[leftpren,
$print,
NewArgs[LIST[p.stringText,
p.b3,
Atom.MakeAtom[p.fontName],
NEW[INT ← p.fontSize],
NEW[INT ← Pack[p.bold, p.italic]]]]];
      p ← p.link}

ENDCASE => ERROR;
ENDLOOP};


{ -- scan the horizontal constraints:
p: HorPtr ← horLpad.link;
q: HorPtr ← horLpad;
r: HorPtr;

UNTIL p = horRpad DO
SELECT operation FROM

move => {IF p.i.copy # NIL THEN p.i ← p.i.copy;
  IF p.j.copy # NIL THEN p.j ← p.j.copy;
   p ← p.link};
  
 copy => {IF p.i.copy # NIL AND p.j.copy # NIL
  THEN {r ← NewHor[];
   r.i ← p.i.copy; r.j ← p.j.copy;
    r.link ← horLpad.link; horLpad.link ← r};
   p ← p.link};
   
delete => IF p.i.copy # NIL AND p.j.copy # NIL
THEN {q.link ← p.link; GcHor[p]; p ← q.link}
   ELSE {q ← p; p ← p.link};
  
mark => {p.i.copy ← NIL; p.j.copy ← NIL; p ← p.link};

build => {IF p.i.name # NIL AND p.j.name # NIL
  THEN AddPred[$hor, PrenArgs[LIST[p.i, p.j]]];
  p ← p.link}
 
ENDCASE => ERROR;
ENDLOOP};

{ -- scan the vertical constraints:
p: VerPtr ← verLpad.link;
q: VerPtr ← verLpad;
r: VerPtr;

UNTIL p = verRpad DO
SELECT operation FROM

move => {IF p.i.copy # NIL THEN p.i ← p.i.copy;
  IF p.j.copy # NIL THEN p.j ← p.j.copy;
   p ← p.link};
  
 copy => {IF p.i.copy # NIL AND p.j.copy # NIL
  THEN {r ← NewVer[];
   r.i ← p.i.copy; r.j ← p.j.copy;
    r.link ← verLpad.link; verLpad.link ← r};
   p ← p.link};
   
delete => IF p.i.copy # NIL AND p.j.copy # NIL
THEN {q.link ← p.link; GcVer[p]; p ← q.link}
   ELSE {q ← p; p ← p.link};
  
mark => {p.i.copy ← NIL; p.j.copy ← NIL; p ← p.link};

build => {IF p.i.name # NIL AND p.j.name # NIL
  THEN AddPred[$ver, PrenArgs[LIST[p.i, p.j]]];
  p ← p.link}

 
ENDCASE => ERROR;
ENDLOOP};

{-- scan the congruence constraints:
p: CongPtr ← congLpad.link;
q: CongPtr ← congLpad;
r: CongPtr;

UNTIL p = congRpad DO
SELECT operation FROM

move => {IF p.i.copy # NIL THEN p.i ← p.i.copy;
  IF p.j.copy # NIL THEN p.j ← p.j.copy;
   IF p.k.copy # NIL THEN p.k ← p.k.copy;
   IF p.l.copy # NIL THEN p.l ← p.l.copy;
   p ← p.link};
  
 copy => {IF p.i.copy # NIL AND p.j.copy # NIL
  AND p.k.copy # NIL AND p.l.copy # NIL
  THEN {r ← NewCong[];
   r.i ← p.i.copy; r.j ← p.j.copy;
    r.k ← p.k.copy; r.l ← p.l.copy;
    r.link ← congLpad.link; congLpad.link ← r};
   p ← p.link};
   
delete => IF p.i.copy # NIL AND p.j.copy # NIL
AND p.k.copy # NIL AND p.l.copy # NIL
THEN {q.link ← p.link; GcCong[p]; p ← q.link}
   ELSE {q ← p; p ← p.link};
  
mark => {p.i.copy ← NIL; p.j.copy ← NIL; p.k.copy ← NIL; p.l.copy ← NIL; p ← p.link};
 
  build => {IF p.i.name # NIL AND p.j.name # NIL
  AND p.k.name # NIL AND p.l.name # NIL
  THEN AddPred[$cong, PrenArgs[LIST[p.i, p.j]], PrenArgs[LIST[p.k, p.l]]];
  p ← p.link}
 
ENDCASE => ERROR;
ENDLOOP};


{-- scan the line constraints:
p: LinPtr ← lineLpad.link;
q: LinPtr ← lineLpad;
r: LinPtr;

UNTIL p = lineRpad DO
SELECT operation FROM

move => {IF p.i.copy # NIL THEN p.i ← p.i.copy;
  IF p.j.copy # NIL THEN p.j ← p.j.copy;
   IF p.k.copy # NIL THEN p.k ← p.k.copy;
   IF p.l.copy # NIL THEN p.l ← p.l.copy;
   p ← p.link};
  
 copy => {IF p.i.copy # NIL AND p.j.copy # NIL
  AND p.k.copy # NIL AND p.l.copy # NIL
  THEN {r ← NewLine[];
   r.i ← p.i.copy; r.j ← p.j.copy;
    r.k ← p.k.copy; r.l ← p.l.copy;
    r.link ← lineLpad.link; lineLpad.link ← r};
   p ← p.link};
   
delete => IF p.i.copy # NIL AND p.j.copy # NIL
AND p.k.copy # NIL AND p.l.copy # NIL
THEN {q.link ← p.link; GcLine[p]; p ← q.link}
   ELSE {q ← p; p ← p.link};
  
mark => {p.i.copy ← NIL; p.j.copy ← NIL; p.k.copy ← NIL; p.l.copy ← NIL; p ← p.link};
 
  build => {IF p.i.name # NIL AND p.j.name # NIL
  AND p.k.name # NIL AND p.l.name # NIL
  THEN AddPred[$para, PrenArgs[LIST[p.i, p.j]], PrenArgs[LIST[p.k, p.l]]];
  p ← p.link}

ENDCASE => ERROR;
ENDLOOP};

{-- scan the counter-clockwise constraints:
p: CCPtr ← ccLpad.link;
q: CCPtr ← ccLpad;
r: CCPtr;

UNTIL p = ccRpad DO
SELECT operation FROM

move => {IF p.i.copy # NIL THEN p.i ← p.i.copy;
  IF p.j.copy # NIL THEN p.j ← p.j.copy;
   IF p.k.copy # NIL THEN p.k ← p.k.copy;
   p ← p.link};
  
 copy => {IF p.i.copy # NIL AND p.j.copy # NIL
  AND p.k.copy # NIL
  THEN {r ← NewCC[];
   r.i ← p.i.copy; r.j ← p.j.copy;
    r.k ← p.k.copy;
    r.link ← ccLpad.link; ccLpad.link ← r};
   p ← p.link};
   
delete => IF p.i.copy # NIL AND p.j.copy # NIL
AND p.k.copy # NIL
THEN {q.link ← p.link; GcCC[p]; p ← q.link}
   ELSE {q ← p; p ← p.link};
  
mark => {p.i.copy ← NIL; p.j.copy ← NIL; p.k.copy ← NIL; p ← p.link};
 
ENDCASE => ERROR;
ENDLOOP};


{ -- scan the algebraic constructions
p: LIST OF ApplyRecord ← constructionList;
q: LIST OF PointPtr ← NIL;
r: LIST OF ApplyRecord ← NIL;

UNTIL p = NIL DO
SELECT operation FROM
move => {q ← p.first.args;
UNTIL q = NIL DO
IF q.first.copy # NIL
THEN q.first ← q.first.copy;
q ← q.rest
ENDLOOP;
p ← p.rest};
copy => {IF AllHaveCopies[p.first.args]
THEN AddX[p.first.f, ListOfCopies[p.first.args]];
p ← p.rest};
delete => {IF AllHaveCopies[p.first.args]
THEN {IF r = NIL THEN {constructionList ← constructionList.rest;
        p ← p.rest}
      ELSE {r.rest ← p.rest; p ← p.rest}}
ELSE {r ← p; p ← p.rest}};
mark => {SetCopiesToNil[p.first.args]; p ← p.rest};

build => {IF AllHaveNames[p.first.args]
    THEN actionList
    ← CONS[LIST[leftpren, p.first.f, Args[p.first.args]],
       actionList];
    p ← p.rest}
ENDCASE => ERROR;
ENDLOOP}


END; -- finally.

AllHaveCopies: PROC[l: LIST OF PointPtr] RETURNS [BOOL] =
{RETURN [l = NIL OR l.first.copy # NIL AND AllHaveCopies[l.rest]]};

AllHaveNames: PROC[l: LIST OF PointPtr] RETURNS [BOOL] =
{RETURN [l = NIL OR l.first.name # NIL AND AllHaveNames[l.rest]]};

ListOfCopies: PROC [l: LIST OF PointPtr] RETURNS [LIST OF PointPtr] =
{IF l = NIL THEN RETURN [NIL];
RETURN [CONS[l.first.copy, ListOfCopies[l.rest]]]};

SetCopiesToNil: PROC [l: LIST OF PointPtr] =
{IF l # NIL THEN {l.first.copy ← NIL; SetCopiesToNil[l.rest]}};

Delete: PUBLIC PROCEDURE =
BEGIN
p: PointPtr ← pointLpad.slink;
UNTIL p = pointRpad DO p.copy ← p; p ← p.slink ENDLOOP;
ScanLists[delete];
ScanLists[mark];
DeleteOriginals[];
END;

DeleteOriginals: PROC[] =
BEGIN
p, q: PointPtr;
p ← pointLpad.link;
q ← pointLpad;
UNTIL p = pointRpad DO
IF p.copy = NIL THEN {q ← p; p ← p.link}
ELSE {p.copy ← NIL; q.link ← p.link; GcPoint[p]; p ← q.link};
ENDLOOP;
END;

Edited March 7, 1984 2:42:12 am PST by Stolfi