subs4q.red 890 B

123456789101112131415161718192021222324252627282930
  1. module subs4q; % Routines for matching quotients.
  2. % Author: Anthony C. Hearn.
  3. % modification to more general quotient matching: Herbert Melenk
  4. % Copyright (c) 1992 RAND. All rights reserved.
  5. symbolic procedure subs4q u;
  6. % U is a standard quotient,
  7. % Value is a standard quotient with all quotient substitutions made.
  8. begin scalar x,w,q,d;
  9. if null(x:=get('slash,'opmtch)) then return u;
  10. w := prepsq u;
  11. remprop('slash,'opmtch); % to prevent endless recursion.
  12. put('slash!*,'opmtch,x);
  13. while w and eqcar(q:=w,'quotient) do
  14. <<w:=opmtch ('slash!* . cdr w) or
  15. smemq('minus,caddr w) and
  16. opmtch{'slash!*,reval{'minus,cadr w},
  17. reval{'minus,caddr w}};
  18. d:=d or w>>;
  19. u:= if d then simp!* q else u;
  20. put('slash,'opmtch,x);
  21. return u;
  22. end;
  23. endmodule;
  24. end;