<< HerculesExprImpl.mesa>> << Last Edited by: Stolfi, February 25, 1984 3:30:31 am PST>> << Was (mostly) JunoAlgebraImplB>> <> <> << 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; END. <<>>