pmrules.red 2.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104
  1. module pmrules; % Basic rules for PM pattern matcher.
  2. % Author: Kevin McIsaac.
  3. algebraic;
  4. % Define logical operators;
  5. % These routines are used so often they should be coded in LISP
  6. % for efficiency.
  7. operator ~; deflist('((!~ !~)),'unary); %precedence ~,not;
  8. infix &; deflist('((!& !&)),'unary); precedence &, and;
  9. remprop('!&,'rtypefn); % Interference with FIDE package.
  10. infix |; deflist('((!| !|)),'unary); precedence |, or;
  11. flag('( & |), 'nary);
  12. flag('( & |),'symmetric);
  13. &(t) :- t; % We must have this else the fourth rule => &(t) -> &() -> 0
  14. &(0) :- 0;
  15. &(0, ??b) :- 0;
  16. &(t, ??b) ::- &(??b);
  17. &(?a,?a,??b) ::- &(?a,??b);
  18. &(?a,~?a,??b) ::- 0;
  19. |(t) :- t;
  20. |(0) :- 0;
  21. |(t,??a) :- t;
  22. |(0,??a) ::- |(??a);
  23. |(?a,?a,??b) ::- |(?a,??b);
  24. |(?a,~?a) :- t;
  25. |(?a,~?a,??b) ::- |(??b);
  26. ~(t) :- 0;
  27. ~(0) :- t;
  28. % Define SMP predicates in terms of their REDUCE equivalents.
  29. symbolic procedure simpbool u;
  30. begin scalar x;
  31. x := get(car u,'boolfn) or car u;
  32. u := for each j in cdr u collect reval j;
  33. u := apply (x, u);
  34. return (if u then !*k2f T else 0) ./ 1
  35. end;
  36. flag('(numberp fixp), 'full);
  37. put('numberp,'simpfn,'simpbool);
  38. put('fixp,'simpfn,'simpbool);
  39. operator numbp, posp, intp, natp, oddp, evnp, complexp, listp;
  40. numbp(?n _=numberp(?n)) :- t;
  41. numbp(?n/?m _=(numberp(?n)&numberp(?m))) :- t;
  42. posp(?n _=(numbp(?n)&?n > 0)) :- t;
  43. posp(?n _=(numbp(?n)&~(?n > 0))) :- 0;
  44. intp(?n _=(numbp(?n)&fixp(?n))) :- t;
  45. intp(?n _=(numbp(?n)&~ fixp(?n))) :- 0;
  46. natp(?i _=(numbp(?i)& intp(?i)&?i>0)) :-t;
  47. natp(?i _=(numbp(?i)&~(intp(?i)&?i>0))) :- 0;
  48. oddp(?x _=(numbp(?x)&intp((?x+1)/2))) :- t;
  49. oddp(?x _=(numbp(?x)&~ intp((?x+1)/2))) :- 0;
  50. evnp(?x _=(numbp(?x)&intp(?x/2))) :- t;
  51. evnp(?x _=(numbp(?x)&~ intp(?x/2))) :- 0;
  52. complexp(i) :- t;
  53. complexp(??b*i) :- t;
  54. complexp(??a + i) :- t;
  55. complexp(??a + ??b*i) :- t;
  56. listp({??x}) :- t;
  57. listp(?x) :- 'nil;
  58. %Polyp
  59. %Primep
  60. %Projp
  61. %Ratp
  62. %Contp
  63. %Fullp
  64. %Symbp
  65. endmodule;
  66. end;