1module forall4; % Support for "let" etc. statements in REDUCE 4. 2 3% Author: Anthony C. Hearn. 4 5% Redistribution and use in source and binary forms, with or without 6% modification, are permitted provided that the following conditions are met: 7% 8% * Redistributions of source code must retain the relevant copyright 9% notice, this list of conditions and the following disclaimer. 10% * Redistributions in binary form must reproduce the above copyright 11% notice, this list of conditions and the following disclaimer in the 12% documentation and/or other materials provided with the distribution. 13% 14% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 15% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, 16% THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 17% PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNERS OR 18% CONTRIBUTORS 19% BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 20% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 21% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 22% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 23% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 24% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 25% POSSIBILITY OF SUCH DAMAGE. 26% 27 28 29% For the time being, we are defaulting to the REDUCE 3 model until we 30% decide how such rules should be handled. 31 32symbolic procedure n_formforall(u,vars); 33 mkobject(formforall(u,vars,'algebraic),'noval); 34 35put('forall,'n_formfn,'n_formforall); 36 37symbolic procedure n_formlet(u,vars); 38 mkobject(formlet(u,vars,'algebraic),'noval); 39 40put('let,'n_formfn,'n_formlet); 41 42symbolic procedure n_formclear(u,vars); 43 mkobject(formclear(u,vars,'algebraic),'noval); 44 45put('clear,'n_formfn,'n_formclear); 46 47symbolic procedure n_formmatch(u,vars); 48 mkobject(formmatch(u,vars,'algebraic),'noval); 49 50put('match,'n_formfn,'n_formmatch); 51 52symbolic procedure form4where(u,vars); 53 begin scalar expn,equivs; 54 expn := n_form1(cadr u,vars); 55 equivs := remcomma caddr u; 56 equivs := formc('list . equivs,vars,'algebraic); 57 equivs := cadr equivs; % FIX THIS. 58 return mkobject( 59 {'prog, '(newrule!* oldrules!* v w), 60 {'setq, 'w, {'set_rules,{'cdr, equivs}, nil}}, % FIX THIS. 61 {'setq, 'u, {'errorset!*, 62 {'mkquote, {'simp4!*,value expn}}, nil}}, 63 '(restore_rules w), 64 '(return (cond ((errorp u) (rederr nil)) (t (car u))))}, 65 type expn) 66 end; 67 68put('where,'n_formfn,'form4where); 69 70endmodule; 71 72end; 73