123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104 |
- module pmrules; % Basic rules for PM pattern matcher.
- % Author: Kevin McIsaac.
- 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;
- remprop('!&,'rtypefn); % Interference with FIDE package.
- 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;
|