tests/rtest_rules.mac

   1 kill (all);
   2 done;
   3
   4 /* Atoms, including false, are OK as rule productions.
   5  * No matchdeclare predicates => match literal expressions only.
   6  */
   7
   8 (tellsimp (foo1 (x), true),
   9  tellsimp (foo2 (x), false),
  10  tellsimp (foo3 (x), %pi),
  11  tellsimp (foo4 (x), 1729),
  12
  13  tellsimpafter (bar1 (x), true),
  14  tellsimpafter (bar2 (x), false),
  15  tellsimpafter (bar3 (x), %pi),
  16  tellsimpafter (bar4 (x), 1729),
  17
  18  defrule (r1, baz1 (x), true),
  19  defrule (r2, baz2 (x), false),
  20  defrule (r3, baz3 (x), %pi),
  21  defrule (r4, baz4 (x), 1729),
  22
  23  0);
  24 0;
  25
  26 [foo1 (x), foo2 (x), foo3 (x), foo4 (x), bar1 (x), bar2 (x), bar3 (x), bar4 (x)];
  27 [true, false, %pi, 1729, true, false, %pi, 1729];
  28
  29 [r1 (baz1 (x)), r2 (baz2 (x)), r3 (baz3 (x)), r4 (baz4 (x))];
  30 [true, false, %pi, 1729];
  31
  32 /* For defrule and defmatch, atoms (both literal and variable) are OK as rule templates.
  33  * (Not OK for tellsimp and tellsimpafter, however.)
  34  */
  35
  36 (defrule (rx, xx, foo_xx),
  37  defrule (r1, 1, foo_1),
  38  defrule (rs, "string", foo_string),
  39  defrule (r17, 17.0, foo_17),
  40  defrule (rtrue, true, foo_true),
  41  defrule (rfalse, false, foo_false),
  42
  43  defmatch (px, xx),
  44  defmatch (p1, 1),
  45  defmatch (ps, "string"),
  46  defmatch (pfloat, 17.0),
  47  defmatch (ptrue, true),
  48  defmatch (pfalse, false),
  49
  50  0);
  51 0;
  52
  53 [rx (xx), r1 (1), rs ("string"), r17 (17.0), rtrue (true), rfalse (false)];
  54 [foo_xx, foo_1, foo_string, foo_17, foo_true, foo_false];
  55
  56 [rx (yy), r1 (2), rs ("string2"), r17 (29.0), rtrue (truly), rfalse (falsely)];
  57 [false, false, false, false, false, false];
  58
  59 [px (xx), p1 (1), ps ("string"), pfloat (17.0), ptrue (true), pfalse (false)];
  60 [true, true, true, true, true, true];
  61
  62 [px (yy), p1 (2), ps ("string2"), pfloat (29.0), ptrue (truly), pfalse (falsely)];
  63 [false, false, false, false, false, false];
  64
  65 (matchdeclare (aa, atom, ii, integerp, ss, stringp, ff, floatnump, bb, booleanp),
  66  booleanp (e) := atom (e) and (e = true or e = false),
  67
  68  defrule (ra, aa, [aa]),
  69  defrule (ri, ii, ii / 10.0),
  70  defrule (rs, ss, concat (ss, "1729")),
  71  defrule (rf, ff, floor (ff)),
  72  defrule (rb, bb, if bb then 1 else 0),
  73
  74  defmatch (pa, aa),
  75  defmatch (pi, ii),
  76  defmatch (ps, ss),
  77  defmatch (pf, ff),
  78  defmatch (pb, bb),
  79
  80  0);
  81 0;
  82
  83 [ra (foobar), ri (17290), rs ("foobar"), rf (17.29), rb (false)];
  84 [[foobar], 1729.0, "foobar1729", 17, 0];
  85
  86 [ra (foo + bar), ri (17290.0), rs (foobar), rf (1729), rb (foo (bar))];
  87 [false, false, false, false, false];
  88
  89 [pa (foobar), pi (17290), ps ("foobar"), pf (1729.0), pb (false)];
  90 [[aa = foobar], [ii = 17290], [ss = "foobar"], [ff = 1729.0], [bb = false]];
  91
  92 [pa (foo + bar), pi (17290.0), ps (foobar), pf (1729), pb (foo (bar))];
  93 [false, false, false, false, false];
  94
  95 /* Match variables are OK as main operator names in defrule and defmatch,
  96  * but not in tellsimp and tellsimpafter. Operators other than the main
  97  * operator can be match variables in tellsimp and tellsimpafter.
  98  * DROP A NOTE TO THIS EFFECT IN RULES.TEXI !!
  99  */
 100
 101 (matchdeclare
 102   ([a, b], atom,
 103     f, lambda ([e], featurep (e, increasing)),
 104    [x, y], all), 0);
 105 0;
 106
 107 (defrule (r1, a(b), b(a)),
 108  defrule (r2, f(x) < f(y), x < y),
 109  defmatch (p1, a(b)),
 110  defmatch (p2, f(x) < f(y)),
 111  0);
 112 0;
 113
 114 [r1 (foo (bar)), r2 (log (u + v) < log (u - v))];
 115 [bar (foo), u + v < u - v];
 116
 117 [p1 (foo (bar)), p2 (log (u + v) < log (u - v))];
 118 [[b = bar, a = foo], [y = u - v, x = u + v, f = log]];
 119
 120 for e in values do apply (remvalue, [e]);
 121 done;
 122
 123 [r1 (foo (bar + baz)), r2 (cosh (x) < cosh (y))];
 124 [false, false];
 125
 126 [p1 (foo (bar + baz)), p2 (cosh (x) < cosh (y))];
 127 [false, false];
 128
 129 (tellsimp (f(x) < f(y), x < y),
 130  tellsimpafter (f(x) > f(y), x > y),
 131  0);
 132 0;
 133
 134 [log (u + v) < log (u - v), cosh (u + v) < cosh (u - v)];
 135 [u + v < u - v, cosh (u + v) < cosh (u - v)];
 136
 137 [sinh (u + v) > sinh (u * v), sin (u + v) > sin (u * v)];
 138 [u + v > u * v, sin (u + v) > sin (u * v)];
 139
 140 /* Various forms of matchdeclare predicates.
 141  * These should different ways to say the same thing.
 142  */
 143
 144 matchdeclare (aa1, true, aa2, all);
 145 done;
 146
 147 matchdeclare
 148   (bb1, integerp,
 149   bb2, integerp(),
 150   bb3, myintegerp_mmacro,
 151   bb4, myintegerp_mmacro(),
 152   bb3, myintegerp_mfunction,
 153   bb4, myintegerp_mfunction(),
 154   bb5, lambda ([x], integerp (x)),
 155   bb6, lambda ([x], integerp (x)) (),
 156   bb7, myintegerp_array_fcn [1234] ());
 157 done;
 158
 159 (myintegerp_mmacro (x) ::= buildq ([x], integerp (x)), myintegerp_mfunction (x) := integerp (x), myintegerp_array_fcn [1234] (x) := integerp (x), 0);
 160 0;
 161
 162 matchdeclare
 163   (cc1, freeof (%e, %i),
 164   cc2, myfreeof_mmacro (%e, %i),
 165   cc3, myfreeof_mfunction (%e, %i),
 166   cc4, lambda ([x, y, z], freeof (x, y, z)) (%e, %i),
 167   cc5, lambda ([[L]], apply (freeof, L)) (%e, %i),
 168   cc6, myfreeof_array_fcn [1234] (%e, %i));
 169 done;
 170
 171 (myfreeof_mmacro ([L]) ::= buildq ([L], freeof (splice (L))), myfreeof_mfunction ([L]) := apply (freeof, L), myfreeof_array_fcn [1234] ([L]) := apply (freeof, L), 0);
 172 0;
 173
 174 /* Rules using equivalent predicate defns should have the same effect.
 175  */
 176
 177 (tellsimpafter (fa1 (aa1), ga (aa1)),
 178 tellsimpafter (fa2 (aa2), ga (aa2)),
 179
 180 tellsimpafter (fb1 (bb1), gb (bb1)),
 181 tellsimpafter (fb2 (bb2), gb (bb2)),
 182 tellsimpafter (fb3 (bb3), gb (bb3)),
 183 tellsimpafter (fb4 (bb4), gb (bb4)),
 184 tellsimpafter (fb5 (bb5), gb (bb5)),
 185 tellsimpafter (fb6 (bb6), gb (bb6)),
 186 tellsimpafter (fb7 (bb7), gb (bb7)),
 187
 188 tellsimpafter (fc1 (cc1), gc (cc1)),
 189 tellsimpafter (fc2 (cc2), gc (cc2)),
 190 tellsimpafter (fc3 (cc3), gc (cc3)),
 191 tellsimpafter (fc4 (cc4), gc (cc4)),
 192 tellsimpafter (fc5 (cc5), gc (cc5)),
 193 tellsimpafter (fc6 (cc6), gc (cc6)),
 194 0);
 195 0;
 196
 197 [fa1 (%pi + %i), fa2 (%pi + %i)];
 198 [ga (%pi + %i), ga (%pi + %i)];
 199
 200 [fb1 (100), fb2 (100), fb3 (100), fb4 (100), fb5 (100), fb6 (100), fb7 (100)];
 201 [gb (100), gb (100), gb (100), gb (100), gb (100), gb (100), gb (100)];
 202
 203 (L : [fb1 (x), fb2 (x), fb3 (x), fb4 (x), fb5 (x), fb6 (x), fb7 (x)], 0);
 204 0;
 205
 206 simp : false;
 207 false;
 208
 209 L;
 210 [fb1 (x), fb2 (x), fb3 (x), fb4 (x), fb5 (x), fb6 (x), fb7 (x)];
 211
 212 simp : true;
 213 true;
 214
 215 [fc1 (x + y), fc2 (x + y), fc3 (x + y), fc4 (x + y), fc5 (x + y), fc6 (x + y)];
 216 [gc (x + y), gc (x + y), gc (x + y), gc (x + y), gc (x + y), gc (x + y)];
 217
 218 (L : [fc1 (%i + y), fc2 (%i + y), fc3 (%i + y), fc4 (%i + y), fc5 (%i + y), fc6 (%i + y)], 0);
 219 0;
 220
 221 simp : false;
 222 false;
 223
 224 L;
 225 [fc1 (%i + y), fc2 (%i + y), fc3 (%i + y), fc4 (%i + y), fc5 (%i + y), fc6 (%i + y)];
 226
 227 simp : true;
 228 true;
 229
 230 /* Repeat tellsimpafter examples using tellsimp.
 231  */
 232
 233 (tellsimp (f2a1 (aa1), ga (aa1)),
 234 tellsimp (f2a2 (aa2), ga (aa2)),
 235
 236 tellsimp (f2b1 (bb1), gb (bb1)),
 237 tellsimp (f2b2 (bb2), gb (bb2)),
 238 tellsimp (f2b3 (bb3), gb (bb3)),
 239 tellsimp (f2b4 (bb4), gb (bb4)),
 240 tellsimp (f2b5 (bb5), gb (bb5)),
 241 tellsimp (f2b6 (bb6), gb (bb6)),
 242 tellsimp (f2b7 (bb7), gb (bb7)),
 243
 244 tellsimp (f2c1 (cc1), gc (cc1)),
 245 tellsimp (f2c2 (cc2), gc (cc2)),
 246 tellsimp (f2c3 (cc3), gc (cc3)),
 247 tellsimp (f2c4 (cc4), gc (cc4)),
 248 tellsimp (f2c5 (cc5), gc (cc5)),
 249 tellsimp (f2c6 (cc6), gc (cc6)),
 250 0);
 251 0;
 252
 253 [f2a1 (%pi + %i), f2a2 (%pi + %i)];
 254 [ga (%pi + %i), ga (%pi + %i)];
 255
 256 [f2b1 (100), f2b2 (100), f2b3 (100), f2b4 (100), f2b5 (100), f2b6 (100), f2b7 (100)];
 257 [gb (100), gb (100), gb (100), gb (100), gb (100), gb (100), gb (100)];
 258
 259 (L : [f2b1 (x), f2b2 (x), f2b3 (x), f2b4 (x), f2b5 (x), f2b6 (x), f2b7 (x)], 0);
 260 0;
 261
 262 simp : false;
 263 false;
 264
 265 L;
 266 [f2b1 (x), f2b2 (x), f2b3 (x), f2b4 (x), f2b5 (x), f2b6 (x), f2b7 (x)];
 267
 268 simp : true;
 269 true;
 270
 271 [f2c1 (x + y), f2c2 (x + y), f2c3 (x + y), f2c4 (x + y), f2c5 (x + y), f2c6 (x + y)];
 272 [gc (x + y), gc (x + y), gc (x + y), gc (x + y), gc (x + y), gc (x + y)];
 273
 274 (L : [f2c1 (%i + y), f2c2 (%i + y), f2c3 (%i + y), f2c4 (%i + y), f2c5 (%i + y), f2c6 (%i + y)], 0);
 275 0;
 276
 277 simp : false;
 278 false;
 279
 280 L;
 281 [f2c1 (%i + y), f2c2 (%i + y), f2c3 (%i + y), f2c4 (%i + y), f2c5 (%i + y), f2c6 (%i + y)];
 282
 283 simp : true;
 284 true;
 285
 286 /* Repeat tellsimpafter examples using defrule.
 287  */
 288
 289 (defrule (rule_a1, f3a1 (aa1), ga (aa1)),
 290 defrule (rule_a2, f3a2 (aa2), ga (aa2)),
 291
 292 defrule (rule_b1, f3b1 (bb1), gb (bb1)),
 293 defrule (rule_b2, f3b2 (bb2), gb (bb2)),
 294 defrule (rule_b3, f3b3 (bb3), gb (bb3)),
 295 defrule (rule_b4, f3b4 (bb4), gb (bb4)),
 296 defrule (rule_b5, f3b5 (bb5), gb (bb5)),
 297 defrule (rule_b6, f3b6 (bb6), gb (bb6)),
 298 defrule (rule_b7, f3b7 (bb7), gb (bb7)),
 299
 300 defrule (rule_c1, f3c1 (cc1), gc (cc1)),
 301 defrule (rule_c2, f3c2 (cc2), gc (cc2)),
 302 defrule (rule_c3, f3c3 (cc3), gc (cc3)),
 303 defrule (rule_c4, f3c4 (cc4), gc (cc4)),
 304 defrule (rule_c5, f3c5 (cc5), gc (cc5)),
 305 defrule (rule_c6, f3c6 (cc6), gc (cc6)),
 306 0);
 307 0;
 308
 309 map (lambda ([e, r], apply (apply1, [e, r])), [f3a1 (%pi + %i), f3a2 (%pi + %i)], [rule_a1, rule_a2]);
 310 [ga (%pi + %i), ga (%pi + %i)];
 311
 312 map (lambda ([e, r], apply (apply1, [e, r])), [f3b1 (100), f3b2 (100), f3b3 (100), f3b4 (100), f3b5 (100), f3b6 (100), f3b7 (100)], [rule_b1, rule_b2, rule_b3, rule_b4, rule_b5, rule_b6, rule_b7]);
 313 [gb (100), gb (100), gb (100), gb (100), gb (100), gb (100), gb (100)];
 314
 315 map (lambda ([e, r], apply (apply1, [e, r])), [f3b1 (x), f3b2 (x), f3b3 (x), f3b4 (x), f3b5 (x), f3b6 (x), f3b7 (x)], [rule_b1, rule_b2, rule_b3, rule_b4, rule_b5, rule_b6, rule_b7]);
 316 [f3b1 (x), f3b2 (x), f3b3 (x), f3b4 (x), f3b5 (x), f3b6 (x), f3b7 (x)];
 317
 318 map (lambda ([e, r], apply (apply1, [e, r])), [f3c1 (x + y), f3c2 (x + y), f3c3 (x + y), f3c4 (x + y), f3c5 (x + y), f3c6 (x + y)], [rule_c1, rule_c2, rule_c3, rule_c4, rule_c5, rule_c6]);
 319 [gc (x + y), gc (x + y), gc (x + y), gc (x + y), gc (x + y), gc (x + y)];
 320
 321 map (lambda ([e, r], apply (apply1, [e, r])), [f3c1 (%i + y), f3c2 (%i + y), f3c3 (%i + y), f3c4 (%i + y), f3c5 (%i + y), f3c6 (%i + y)], [rule_c1, rule_c2, rule_c3, rule_c4, rule_c5, rule_c6]);
 322 [f3c1 (%i + y), f3c2 (%i + y), f3c3 (%i + y), f3c4 (%i + y), f3c5 (%i + y), f3c6 (%i + y)];
 323
 324 /* Repeat tellsimpafter examples using defmatch.
 325  */
 326
 327 (defmatch (prog_a1, f4a1 (aa1)),
 328 defmatch (prog_a2, f4a2 (aa2)),
 329
 330 defmatch (prog_b1, f4b1 (bb1)),
 331 defmatch (prog_b2, f4b2 (bb2)),
 332 defmatch (prog_b3, f4b3 (bb3)),
 333 defmatch (prog_b4, f4b4 (bb4)),
 334 defmatch (prog_b5, f4b5 (bb5)),
 335 defmatch (prog_b6, f4b6 (bb6)),
 336 defmatch (prog_b7, f4b7 (bb7)),
 337
 338 defmatch (prog_c1, f4c1 (cc1)),
 339 defmatch (prog_c2, f4c2 (cc2)),
 340 defmatch (prog_c3, f4c3 (cc3)),
 341 defmatch (prog_c4, f4c4 (cc4)),
 342 defmatch (prog_c5, f4c5 (cc5)),
 343 defmatch (prog_c6, f4c6 (cc6)),
 344 0);
 345 0;
 346
 347 map (lambda ([e, r], r(e)), [f4a1 (%pi + %i), f4a2 (%pi + %i)], [prog_a1, prog_a2]);
 348 ['[aa1 = %pi + %i], '[aa2 = %pi + %i]];
 349
 350 map (lambda ([e, r], r(e)), [f4b1 (100), f4b2 (100), f4b3 (100), f4b4 (100), f4b5 (100), f4b6 (100), f4b7 (100)], [prog_b1, prog_b2, prog_b3, prog_b4, prog_b5, prog_b6, prog_b7]);
 351 ['[bb1 = 100], '[bb2 = 100], '[bb3 = 100], '[bb4 = 100], '[bb5 = 100], '[bb6 = 100], '[bb7 = 100]];
 352
 353 map (lambda ([e, r], r(e)), [f4b1 (x), f4b2 (x), f4b3 (x), f4b4 (x), f4b5 (x), f4b6 (x), f4b7 (x)], [prog_b1, prog_b2, prog_b3, prog_b4, prog_b5, prog_b6, prog_b7]);
 354 [false, false, false, false, false, false, false];
 355
 356 map (lambda ([e, r], r(e)), [f4c1 (x + y), f4c2 (x + y), f4c3 (x + y), f4c4 (x + y), f4c5 (x + y), f4c6 (x + y)], [prog_c1, prog_c2, prog_c3, prog_c4, prog_c5, prog_c6]);
 357 ['[cc1 = y + x], '[cc2 = y + x], '[cc3 = y + x], '[cc4 = y + x], '[cc5 = y + x], '[cc6 = y + x]];
 358
 359 map (lambda ([e, r], r(e)), [f4c1 (%i + y), f4c2 (%i + y), f4c3 (%i + y), f4c4 (%i + y), f4c5 (%i + y), f4c6 (%i + y)], [prog_c1, prog_c2, prog_c3, prog_c4, prog_c5, prog_c6]);
 360 [false, false, false, false, false, false];
 361
 362 /* Re-do above examples using DEFMSPEC functions in matchdeclare predicates.
 363  * Commenting out this part because :lisp is not recognized in test scripts.
 364 :lisp (defmspec $myintegerp_mspec (l) ($integerp (meval (cadr l))))
 365 :lisp (defmspec $myfreeof_mspec (l) (apply '$freeof (mapcar #'meval (cdr l))))
 366
 367 (matchdeclare
 368    (dd1, myintegerp_mspec,
 369     dd2, myintegerp_mspec (),
 370     ee1, myfreeof_mspec (%e, %i)),
 371  0);
 372 0;
 373
 374 (tellsimpafter (fd1 (dd1), gd (dd1)),
 375  tellsimpafter (fd2 (dd2), gd (dd2)),
 376  tellsimpafter (fe1 (ee1), ge (ee1)),
 377
 378  tellsimp (f2d1 (dd1), gd (dd1)),
 379  tellsimp (f2d2 (dd2), gd (dd2)),
 380  tellsimp (f2e1 (ee1), ge (ee1)),
 381
 382  defrule (rule_d1, f3d1 (dd1), gd (dd1)),
 383  defrule (rule_d2, f3d2 (dd2), gd (dd2)),
 384  defrule (rule_e1, f3e1 (ee1), ge (ee1)),
 385
 386  defmatch (prog_d1, f4d1 (dd1)),
 387  defmatch (prog_d2, f4d2 (dd2)),
 388  defmatch (prog_e1, f4e1 (ee1)),
 389  0);
 390 0;
 391
 392 [fd1 (100), fd2 (100), fe1 (x + y),
 393  f2d1 (100), f2d2 (100), f2e1 (x + y),
 394  apply1 (f3d1 (100), rule_d1), apply1 (f3d2 (100), rule_d2), apply1 (f3e1 (x + y), rule_e1),
 395  prog_d1 (f4d1 (100)), prog_d2 (f4d2 (100)), prog_e1 (f4e1 (x + y))];
 396 [gd (100), gd (100), ge (x + y),
 397  gd (100), gd (100), ge (x + y),
 398  gd (100), gd (100), ge (x + y),
 399  '[dd1 = 100], '[dd2 = 100], '[ee1 = x + y]];
 400
 401 (L : [fd1 (x), fd2 (x), f2d1 (x), f2d2 (x)], 0);
 402 0;
 403
 404 simp : false;
 405 false;
 406
 407 L;
 408 [fd1 (x), fd2 (x), f2d1 (x), f2d2 (x)];
 409
 410 simp : true;
 411 true;
 412  */
 413
 414 /* Examples of built-in and user-defined binary operators.
 415  */
 416
 417 (infix ("@@"),
 418  "@@" (a, b) := integerp(a) and integerp(b) and remainder(b, a) = 0,
 419  matchdeclare (aa, "<"(100), bb, ">"(100), cc, "="(100), dd, "#"(100), ee, "@@"(100)),
 420  tellsimpafter (FOO1 (aa, bb, cc, dd, ee), BAR1 (aa - 100, 100 - bb, cc - 100, dd - 100, ee / 100)),
 421  0);
 422 0;
 423
 424 FOO1 (17, 29, 1729, 29, 17);
 425 FOO1 (17, 29, 1729, 29, 17);
 426
 427 FOO1 (1729, 17, 100, 29, 172900);
 428 BAR1 (1729 - 100, 100 - 17, 0, 29 - 100, 1729);
 429
 430 /* Undecided expressions should be treated as failed matches
 431  * (i.e. without causing a predicate evaluation error,
 432  * and without treating some non-false value as true)
 433  */
 434 (matchdeclare (aa, "<"(foo0), bb, ">"(foo0), cc, "="(foo0), dd, "#"(foo0)),
 435  tellsimpafter (BAZ1 (aa, bb, cc, dd), BLURF1 (aa - foo0, foo0 - bb, 0, dd - foo0)),
 436  0);
 437 0;
 438
 439 (BAZ1 (1729, 17, 100, 29), [op (%%), args (%%)]);
 440 [BAZ1, [1729, 17, 100, 29]];
 441
 442 foo0 : 100;
 443 100;
 444
 445 BAZ1 (1729, 17, 100, 29);
 446 BLURF1 (1729 - 100, 100 - 17, 0, 29 - 100);
 447
 448 /* Arguments appearing in matched expressions should be evaluated just once
 449  * (just as they would be if there were no matching).
 450  */
 451
 452 /* NEED EXAMPLES HERE !! */
 453
 454 /* Additional miscellaneous examples.
 455  */
 456 (nzc (e) := constantp (e) and e # 0,
 457  matchdeclare ([aa, bb], constantp, [xx, yy, zz], nzc),
 458  declare (C1, constant),
 459  r1: first (tellsimp (quux (aa, bb), foo (bb, aa))),
 460  r2: first (tellsimp (foo (aa, bb), bar (aa*bb))),
 461  r3: first (tellsimp (baz (aa, bb), foo (bb, aa))),
 462  0);
 463 0;
 464
 465 /* Verify that tellsimp-defined rules are applied one after another.
 466  */
 467
 468 baz (%pi, %i);
 469 bar (%i*%pi);
 470
 471 q1: quux (73, C1);
 472 bar (C1*73);
 473
 474 /* I'd like to kill just r1, but remrule has at least one bug (SF bug # 1204711)
 475  */
 476 remrule (quux, all);
 477 quux;
 478
 479 quux (73, C1);
 480 '(quux (73, C1));
 481
 482 (r4: first (tellsimpafter (quux (xx, yy), glurf (xx^yy))), 0);
 483 0;
 484
 485 quux (73, C1);
 486 glurf (73^C1);
 487
 488 /* For bug [ 1120546 ] defrule (a, b, c) (all atoms) confuses kill (rules)
 489  */
 490
 491 kill (all);
 492 done;
 493
 494 (defrule (a, b, c), 0);
 495 0;
 496
 497 kill (rules);
 498 done;
 499
 500 /* Unreported bug: patterns for + or * match any operator (not just + or *)
 501  * when + or * is not the top-level operator and pattern variables
 502  * partition the arguments of + or *.
 503  */
 504
 505 (matchdeclare (xx, integerp, yy, lambda ([ee], not integerp (ee))),
 506  defrule (r1, FOO (xx + yy), FOOPLUS (xx, yy)),
 507  defrule (r2, FOO (xx * yy), FOOTIMES (xx, yy)),
 508  0);
 509 0;
 510
 511 apply1 (FOO (a + b + c + 123), r1);
 512 FOOPLUS (123, a + b + c);
 513
 514 apply1 (FOO (x * y * z * 234), r2);
 515 FOOTIMES (234, x * y * z);
 516
 517 apply1 (FOO (BAR (a, b, c, 123)), r1, r2);
 518 FOO (BAR (a, b, c, 123));
 519
 520 apply1 (FOO (x + y + z + 345), r2);
 521 FOO (x + y + z + 345);
 522
 523 apply1 (FOO (s * t * u * v * 456), r1);
 524 FOO (s * t * u * v * 456);
 525
 526 /* Seems to work OK when pattern variables do not partition the arguments.
 527  * Verify that continues to work after bug fix.
 528  */
 529 (matchdeclare (xx, bfloatp, yy, symbolp),
 530  defrule (r3, BAR (xx + yy), BARPLUS (xx, yy)),
 531  defrule (r4, BAR (xx * yy), BARTIMES (xx, yy)),
 532  0);
 533 0;
 534
 535 apply1 (BAR (1b0 + x + y), r3);
 536 BARPLUS (1b0, x + y);
 537
 538 apply1 (BAR (2b0 * u * v), r4);
 539 BARTIMES (2b0, u * v);
 540
 541 apply1 (BAR (FOO (3b0, g, h)), r3, r4);
 542 BAR (FOO (3b0, g, h));
 543
 544 apply1 (BAR (4b0 * m * n), r3);
 545 BAR (4b0 * m * n);
 546
 547 apply1 (BAR (5b0 + p + q), r4);
 548 BAR (5b0 + p + q);
 549
 550 /* Examples derived from mailing list 2008-03-23
 551  */
 552
 553 (kill (aa, bb, foo, bar),
 554  matchdeclare
 555    (aa, integerp,
 556     bb, floatnump,
 557     foo, lambda ([ee], member (ee, '[sin, cos]))),
 558  defmatch (bar, bb * foo (aa)),
 559  0);
 560 0;
 561
 562 (bar (12.345 * sin (54321)),
 563  if %% = false then false else sort (%%));
 564 [aa = 54321, bb = 12.345, foo = sin];
 565
 566 (matchdeclare
 567    (aa, floatnump,
 568     bb, integerp),
 569  defmatch (baztimes, aa * foo (bb)),
 570  defmatch (bazplus, aa + foo (bb)),
 571  0);
 572 0;
 573
 574 (baztimes (12.345 * sin (54321)),
 575  if %% = false then false else sort (%%));
 576 [aa = 12.345, bb = 54321, foo = sin];
 577
 578 (bazplus (12.345 + sin (54321)),
 579  if %% = false then false else sort (%%));
 580 [aa = 12.345, bb = 54321, foo = sin];
 581
 582 /* "rule issue" mailing list 2014-06-29 */
 583
 584 (matchdeclare (u, atom, fn, symbolp),
 585  defrule (ddint21, 'integrate(delta(u)*fn(u), u, minf, inf), fn(0)),
 586  ddint21('integrate(delta(u)*fn(u), u, minf, inf)));
 587 fn(0);
 588
 589 (kill (f), apply1 (1/(1 + 'integrate (f(x)*delta(x), x, minf, inf)), ddint21));
 590 1/(1 + f(0));
 591
 592 (kill (blurf),
 593  defrule (r1, 'integrate (blurf(u) + fn(u), u, minf, inf), fn(1)),
 594  r1 ('integrate (blurf(a) + g(a), a, minf, inf)));
 595 g(1);
 596
 597 /* rule for f interferes with function definition after kill
 598  * discussion on mailing list circa 2015-08-17: "trouble with GCL build"
 599  */
 600 (kill (all),
 601  matchdeclare (xx, integerp),
 602  tellsimp (f(xx), subst ('xx = xx, lambda ([a], a - xx))),
 603  kill (rules),
 604  f(n) := n + 1,
 605  translate(f),
 606  kill(f),
 607  f(y):=y+3,
 608  [fundef (f), f (10)]);
 609 [f(y) := y + 3, 13];
 610
 611 /* Verify that tellsimpafter rules are all applied.
 612  * This is a test for commit 801a0bb which creates one *AFTERFLAG per rule.
 613  * For good measure, verify that tellsimp and defrule work the same way.
 614  */
 615
 616 (simp:false,
 617  kill (f, g, h, i, j, rj1, rj2, rj3),
 618  tellsimpafter (f(1), f(0)),
 619  tellsimpafter (f(2), f(1)),
 620  tellsimpafter (f(3), f(2)),
 621  tellsimpafter (g(3), g(2)),
 622  tellsimpafter (g(2), g(1)),
 623  tellsimpafter (g(1), g(0)),
 624  tellsimp (h(1), h(0)),
 625  tellsimp (h(2), h(1)),
 626  tellsimp (h(3), h(2)),
 627  tellsimp (i(3), i(2)),
 628  tellsimp (i(2), i(1)),
 629  tellsimp (i(1), i(0)),
 630  defrule (rj1, j(1), j(0)),
 631  defrule (rj2, j(2), j(1)),
 632  defrule (rj3, j(3), j(2)),
 633  simp:true);
 634 true;
 635
 636 [f(1), f(2), f(3)];
 637 [f(0), f(0), f(0)];
 638
 639 [g(1), g(2), g(3)];
 640 [g(0), g(0), g(0)];
 641
 642 [h(1), h(2), h(3)];
 643 [h(0), h(0), h(0)];
 644
 645 [i(1), i(2), i(3)];
 646 [i(0), i(0), i(0)];
 647
 648 /* apply1 applies rj1 until it fails, then rj2, then rj3.
 649  * Since apply1 doesn't go back and try rj1 after rj2, or rj2 after rj3,
 650  * it's expected that the result of apply1 isn't maximally simplified.
 651  */
 652 apply1 ([j(1), j(2), j(3)], rj1, rj2, rj3);
 653 [j(0), j(1), j(2)];
 654
 655 /* apply1 with rules in reverse order does produce j(0) in each case here.
 656  */
 657 apply1 ([j(1), j(2), j(3)], rj3, rj2, rj1);
 658 [j(0), j(0), j(0)];
 659
 660 /* apply2 reapplies earlier rules if a later one succeeds.
 661  * So it's expected that the results will be maximally simplified,
 662  * with rules in either order.
 663  */
 664 apply2 ([j(1), j(2), j(3)], rj1, rj2, rj3);
 665 [j(0), j(0), j(0)];
 666
 667 apply2 ([j(1), j(2), j(3)], rj3, rj2, rj1);
 668 [j(0), j(0), j(0)];
 669
 670 /* applyb1, like apply1, doesn't reapply rules,
 671  * so it's expected results depend on the order of the rules.
 672  */
 673 applyb1 ([j(1), j(2), j(3)], rj1, rj2, rj3);
 674 [j(0), j(1), j(2)];
 675
 676 applyb1 ([j(1), j(2), j(3)], rj3, rj2, rj1);
 677 [j(0), j(0), j(0)];
 678
 679 /* Another test for commit 801a0bb. This time it's expected that *AFTERFLAG
 680  * prevents repeated application of the same tellsimpafter rule,
 681  * but a tellsimp rule is applied repeatedly (because it has no *AFTERFLAG).
 682  */
 683
 684 (kill(nn, k, l),
 685  matchdeclare (nn, lambda ([e], integerp(e) and e > 0)),
 686  tellsimpafter (k(nn), nn + k(nn - 1)),
 687  tellsimp (l(nn), nn + l(nn - 1)),
 688  0);
 689 0;
 690
 691 /* It's difficult to test the result of k(4) because k(3) + 4 is not maximally simplified
 692  * and the test mechanism applies simplification to both the actual and expected results.
 693  * See SIMPLE-EQUAL-P and APPROX-ALIKE in src/mload.lisp.
 694  */
 695 string (k(4));
 696 "k(3)+4";
 697
 698 /* On the other hand, l(0) is maximally simplified, so there's no difficulty here.
 699  */
 700 l(4);
 701 10 + l(0);
 702
 703 /* Another test for commit 801a0bb.
 704  * Tellsimpafter rules change operator from f, to g, to h, to i.
 705  */
 706
 707 (kill(f, g, h, i),
 708  simp:false,
 709  tellsimpafter(f(1), g(1)),
 710  tellsimpafter(g(1), h(1)),
 711  tellsimpafter(h(1), i(1)),
 712  simp:true);
 713 true;
 714
 715 f(1);
 716 i(1);