Artifact 48b2b35f0cd80a0d46ddc93595ca0749161dc5439a93265ab4264fecae191469:

• Executable file r37/packages/poly/subs4q.red — part of check-in [f2fda60abd] at 2011-09-02 18:13:33 on branch master — Some historical releases purely for archival purposes

  git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/trunk/historical@1375 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 890) [annotate] [blame] [check-ins using] [more...]

• Executable file r38/packages/poly/subs4q.red — part of check-in [f2fda60abd] at 2011-09-02 18:13:33 on branch master — Some historical releases purely for archival purposes

  git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/trunk/historical@1375 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 890) [annotate] [blame] [check-ins using]

module subs4q; % Routines for matching quotients.

% Author: Anthony C. Hearn.
%         modification to more general quotient matching: Herbert Melenk

% Copyright (c) 1992 RAND.  All rights reserved.

symbolic procedure subs4q u;
   % U is a standard quotient,
   % Value is a standard quotient with all quotient substitutions made.
   begin scalar x,w,q,d;
      if null(x:=get('slash,'opmtch)) then return u;
      w := prepsq u;
      remprop('slash,'opmtch); % to prevent endless recursion.
      put('slash!*,'opmtch,x);
      while w and eqcar(q:=w,'quotient) do
          <<w:=opmtch ('slash!* . cdr w) or
               smemq('minus,caddr w) and
		  opmtch{'slash!*,reval{'minus,cadr w},
				  reval{'minus,caddr w}};
            d:=d or w>>;
      u:= if d then simp!* q else u;
      put('slash,'opmtch,x);
      return u;
   end;

endmodule;

end;