module pmrules; % Basic rules for PM pattern matcher.
% Author: Kevin McIsaac.
create!-package('(pmrules), '(contrib pm));
% Other packages needed.
load!-package 'pm;
algebraic;
% Define logical operators;
% These routines are used so often they should be coded in LISP
% for efficiency.
operator ~; deflist('((!~ !~)),'unary); %precedence ~,not;
infix &; deflist('((!& !&)),'unary); precedence &, and;
infix |; deflist('((!| !|)),'unary); precedence |, or;
flag('( & |), 'nary);
flag('( & |),'symmetric);
&(t) :- t; % We must have this else the fourth rule => &(t) -> &() -> 0
&(0) :- 0;
&(0, ??b) :- 0;
&(t, ??b) ::- &(??b);
&(?a,?a,??b) ::- &(?a,??b);
&(?a,~?a,??b) ::- 0;
|(t) :- t;
|(0) :- 0;
|(t,??a) :- t;
|(0,??a) ::- |(??a);
|(?a,?a,??b) ::- |(?a,??b);
|(?a,~?a) :- t;
|(?a,~?a,??b) ::- |(??b);
~(t) :- 0;
~(0) :- t;
% Define SMP predicates in terms of their REDUCE equivalents.
symbolic procedure simpbool u;
begin scalar x;
x := get(car u,'boolfn) or car u;
u := for each j in cdr u collect reval j;
u := apply (x, u);
return (if u then !*k2f t else 0) ./ 1
end;
flag('(numberp fixp), 'full);
put('numberp,'simpfn,'simpbool);
put('fixp,'simpfn,'simpbool);
operator numbp, posp, intp, natp, oddp, evnp, complexp, listp;
numbp(?n _=numberp(?n)) :- t;
numbp(?n/?m _=(numberp(?n)&numberp(?m))) :- t;
posp(?n _=(numbp(?n)&?n > 0)) :- t;
posp(?n _=(numbp(?n)&~(?n > 0))) :- 0;
intp(?n _=(numbp(?n)&fixp(?n))) :- t;
intp(?n _=(numbp(?n)&~ fixp(?n))) :- 0;
natp(?i _=(numbp(?i)& intp(?i)&?i>0)) :-t;
natp(?i _=(numbp(?i)&~(intp(?i)&?i>0))) :- 0;
oddp(?x _=(numbp(?x)&intp((?x+1)/2))) :- t;
oddp(?x _=(numbp(?x)&~ intp((?x+1)/2))) :- 0;
evnp(?x _=(numbp(?x)&intp(?x/2))) :- t;
evnp(?x _=(numbp(?x)&~ intp(?x/2))) :- 0;
complexp(i) :- t;
complexp(??b*i) :- t;
complexp(??a + i) :- t;
complexp(??a + ??b*i) :- t;
listp({??x}) :- t;
listp(?x) :- 'nil;
%Polyp
%Primep
%Projp
%Ratp
%Contp
%Fullp
%Symbp
endmodule;
end;