Procedures for manipulating symbolic expressions.
DIRECTORY
HerculesStorage,
HerculesAlgebra,
HerculesImage,
HerculesSolver,
HerculesGraphics,
Graphics USING[black, white, Color, StrokeEnds],
Real USING [RoundLI, RoundI, FRem, SqRt],
Rope,
Convert USING [RopeFromInt, RopeFromReal],
Atom;
HerculesExprImpl:
PROGRAM
IMPORTS
HerculesGraphics, HerculesImage, HerculesStorage, HerculesSolver, Atom, Real, Convert
EXPORTS
HerculesAlgebra
BEGIN
OPEN
Stor: HerculesStorage,
Gr: HerculesGraphics,
Im: HerculesImage,
Solv: HerculesSolver,
HerculesAlgebra;
- - - - MOLDS AND CASTING
Fits:
PUBLIC PROC [e: Se, mold: Mold]
RETURNS [fits:
BOOL, culprit: Se] =
BEGIN
fits ← false; -- guilty until proof to the contrary...
IF mold = NIL THEN fits ← (e = NIL)
ELSE WITH mold SELECT FROM
mm: ATOM =>
{SELECT mm FROM
$ANY => fits ← TRUE;
$ATOM => fits ← (e # NIL AND ISTYPE [e, ATOM]);
$LIST => fits ← (e = NIL OR ISTYPE [e, LIST OF Value]);
$NUM => fits ← (e # NIL AND ISTYPE [e, NumPtr]);
$INT =>
fits ← (e # NIL AND ISTYPE [e, NumPtr] AND NARROW[e, NumPtr].int);
$ROPE => fits ← (e = NIL OR ISTYPE [e, RopePtr]);
$FUN => fits ← (e# NIL AND ISTYPE [e, FunPtr]);
ENDCASE => Gr.Error["Invalid mold: ", Atom.GetPName [mm]]};
mm: UnionMold =>
{m: LIST OF Mold ← mm.alts;
WHILE m # NIL AND NOT fits DO
fits ← Fits [e, m.first].fits;
m ← m.rest
ENDLOOP};
mm: ListMold =>
{IF e = NIL OR ISTYPE [e, LIST OF Se] THEN
{ep: LIST OF Se ← NARROW [e];
ne: INT ← 0;
WHILE ep # NIL DO
[fits, culprit] ← Fits [ep.first, mm.elm];
IF NOT fits THEN RETURN;
ep ← ep.rest; ne ← ne + 1
ENDLOOP;
fits ← (ne >= mm.min AND (mm.max = LAST[INTEGER] OR ne <= mm.max))}};
mm: LIST OF Mold =>
{IF e # NIL AND ISTYPE [e, LIST OF Se] THEN
{ep: LIST OF Se ← NARROW [e];
mp: LIST OF Mold ← mm;
WHILE ep # NIL AND mp # NIL DO
[fits, culprit] ← Fits [ep.first, mp.first];
IF NOT fits THEN RETURN;
ep ← ep.rest; mp ← mp.rest
ENDLOOP;
fits ← ep = NIL AND mp = NIL}}
ENDCASE =>
{Gr.Error ["Invalid mold"]};
IF NOT fits THEN culprit ← e -- can't be more specific
END;
IsList:
PUBLIC
PROC [e: Se, min:
INTEGER ← 0, max:
INTEGER ←
LAST[
INTEGER]]
RETURNS [fits:
BOOL, list:
LIST
OF Se] =
BEGIN
IF e = NIL OR ISTYPE [e, LIST OF Se] THEN
{list ← NARROW [e];
ep: LIST OF Se ← list;
ne: INT ← 0;
WHILE ne < min DO
IF ep=NIL THEN {fits ← FALSE; RETURN};
ep ← ep.rest; ne ← ne+1
ENDLOOP;
IF max = LAST[INTEGER] THEN RETURN;
WHILE ep # NIL DO
IF ne > max THEN {fits ← FALSE; RETURN};
ep ← ep.rest; ne ← ne + 1
ENDLOOP};
END;
IsUnAppl:
PUBLIC
PROC [e: Se, op: Se]
RETURNS [fits:
BOOL, arg: Se] =
BEGIN
lst: LIST OF Se;
[fits, lst] ← IsList[e, 2, 2];
IF fits THEN
{IF lst.first = op THEN
{arg ← lst.rest.first}
ELSE
{fits ← FALSE}}
END;
IsBinAppl:
PUBLIC
PROC [e: Se, op: Se]
RETURNS [fits:
BOOL, larg, rarg: Se] =
BEGIN
lst: LIST OF Se;
[fits, lst] ← IsList[e, 3, 3];
IF fits THEN
{IF lst.first = op THEN
{larg ← lst.rest.first;
rarg ← lst.rest.rest.first}
ELSE
{fits ← FALSE}}
END;
InvalidSe: PUBLIC ERROR [e: Se] = CODE;
ToList:
PUBLIC
PROC [e: Se, min:
INTEGER ← 0, max:
INTEGER ←
LAST[
INTEGER]]
RETURNS [list:
LIST
OF Se] =
BEGIN
fits: BOOL;
[fits, list] ← IsList[e, min, max];
IF NOT fits THEN ERROR InvalidSe[e]
END;
- - - - LIST MANIPULATION PROCS
Car:
PUBLIC
PROC [r: Se]
RETURNS [Se] =
{RETURN[NARROW[r, LIST OF REF ANY].first]};
Cdr:
PUBLIC
PROC [r: Se]
RETURNS [Se] =
{RETURN[NARROW[r, LIST OF REF ANY].rest]};
Cadr:
PUBLIC
PROC [r: Se]
RETURNS [Se] =
{RETURN[Car[Cdr[r]]]};
Caddr:
PUBLIC
PROC [r: Se]
RETURNS [Se] =
{RETURN[Car[Cdr[Cdr[r]]]]};
Unnest:
PUBLIC
PROC[e: Se, op, zero: Se, tail:
LIST
OF Se ←
NIL]
RETURNS [list:
LIST
OF Se] =
BEGIN
fits: BOOL;
DoUnnest: PROC[ex: Se, tl: LIST OF Se] RETURNS [ep: LIST OF Se] =
BEGIN
IF ex = zero THEN
RETURN [tail]
ELSE
{[fits, ep] ← IsList[ex, 3, 3];
IF NOT fits OR ep.first # op
THEN ep ← CONS[ex, tl]
ELSE ep ← DoUnnest[ep.rest.first, DoUnnest[ep.rest.rest.first, tl]]
END;
list ← DoUnnest[e, tail]
END;
- - - - ASSOCIATION LISTS
InsertDef:
PUBLIC
PROC [name:
ATOM, value: Se, alist: Alist]
RETURNS [new: Alist] =
BEGIN
new ← CONS[name, CONS[value, alist]]
END;.
GetDef:
PUBLIC
PROC [name:
ATOM, alist: Alist, backup: Alist ←
NIL]
RETURNS [value: Se] =
BEGIN
WHILE alist # NIL DO
IF alist.first = name THEN RETURN [alist.rest.first];
alist ← alist.rest.rest
ENDLOOP;
WHILE backup # NIL DO
IF backup.first = name THEN RETURN [backup.rest.first];
backup ← backup.rest.rest
ENDLOOP;
RETURN [NIL]
END;
ParmNumberError: PUBLIC ERROR = CODE;
BindArgs:
PUBLIC
PROC [parms:
LIST
OF Se, args:
LIST
OF Se, alist: Alist]
RETURNS [new: Alist] =
BEGIN
IF parms = NIL AND args = NIL THEN
{RETURN[alist]}
ELSE IF parms = NIL OR args = NIL THEN
{ERROR ParmNumberError}
ELSE
{RETURN[CONS[parms.first, CONS[args.first, BindArgs[parms.rest, args.rest, alist]]]]}
END;
- - - - MISCELLANEOUS
SureInt: REAL = 200000000B; -- a REAL this big surely is an inexact integer
MakeNumber:
PROC [val:
REAL, int, const:
BOOL ←
FALSE]
RETURNS [n: NumPtr] =
BEGIN
IF int THEN
{IFABS[val] < SureInt THEN
{val ← Real.RoundLI[val];
int ← ( val - (IF val>0 THEN 1 ELSE -1) # val )}
ELSE
{int ← FALSE}};
RETURN[NEW [NumCell ← [val: val, int: int, const: const]]]
END;