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 FOOPLUS (0, BAR (a, b, c, 123));
 519
 520 apply1 (FOO (BAR (a, b, c, 123)), r2, r1);
 521 FOOTIMES (1, BAR (a, b, c, 123));
 522
 523 apply1 (FOO (x + y + z + 345), r2);
 524 FOOTIMES (1, x + y + z + 345);
 525
 526 apply1 (FOO (s * t * u * v * 456), r1);
 527 FOOPLUS (0, s * t * u * v * 456);
 528
 529 (matchdeclare (xx, lambda ([e], integerp(e) and e # 0), yy, lambda ([ee], not integerp (ee))),
 530  defrule (r1, FOO (xx + yy), FOOPLUS (xx, yy)),
 531  matchdeclare (xx, lambda ([e], integerp(e) and e # 1)),
 532  defrule (r2, FOO (xx * yy), FOOTIMES (xx, yy)),
 533  0);
 534 0;
 535
 536 apply1 (FOO (a + b + c + 123), r1);
 537 FOOPLUS (123, a + b + c);
 538
 539 apply1 (FOO (x * y * z * 234), r2);
 540 FOOTIMES (234, x * y * z);
 541
 542 apply1 (FOO (BAR (a, b, c, 123)), r1, r2);
 543 FOO (BAR (a, b, c, 123));
 544
 545 apply1 (FOO (BAR (a, b, c, 123)), r2, r1);
 546 FOO (BAR (a, b, c, 123));
 547
 548 apply1 (FOO (x + y + z + 345), r2);
 549 FOO (x + y + z + 345);
 550
 551 apply1 (FOO (s * t * u * v * 456), r1);
 552 FOO (s * t * u * v * 456);
 553
 554 /* Seems to work OK when pattern variables do not partition the arguments.
 555  * Verify that continues to work after bug fix.
 556  */
 557 (matchdeclare (xx, bfloatp, yy, symbolp),
 558  defrule (r3, BAR (xx + yy), BARPLUS (xx, yy)),
 559  defrule (r4, BAR (xx * yy), BARTIMES (xx, yy)),
 560  0);
 561 0;
 562
 563 apply1 (BAR (1b0 + x + y), r3);
 564 BARPLUS (1b0, x + y);
 565
 566 apply1 (BAR (2b0 * u * v), r4);
 567 BARTIMES (2b0, u * v);
 568
 569 apply1 (BAR (FOO (3b0, g, h)), r3, r4);
 570 BAR (FOO (3b0, g, h));
 571
 572 apply1 (BAR (4b0 * m * n), r3);
 573 BAR (4b0 * m * n);
 574
 575 apply1 (BAR (5b0 + p + q), r4);
 576 BAR (5b0 + p + q);
 577
 578 /* Examples derived from mailing list 2008-03-23
 579  */
 580
 581 (kill (aa, bb, foo, bar),
 582  matchdeclare
 583    (aa, integerp,
 584     bb, floatnump,
 585     foo, lambda ([ee], member (ee, '[sin, cos]))),
 586  defmatch (bar, bb * foo (aa)),
 587  0);
 588 0;
 589
 590 (bar (12.345 * sin (54321)),
 591  if %% = false then false else sort (%%));
 592 [aa = 54321, bb = 12.345, foo = sin];
 593
 594 (matchdeclare
 595    (aa, floatnump,
 596     bb, integerp),
 597  defmatch (baztimes, aa * foo (bb)),
 598  defmatch (bazplus, aa + foo (bb)),
 599  0);
 600 0;
 601
 602 (baztimes (12.345 * sin (54321)),
 603  if %% = false then false else sort (%%));
 604 [aa = 12.345, bb = 54321, foo = sin];
 605
 606 (bazplus (12.345 + sin (54321)),
 607  if %% = false then false else sort (%%));
 608 [aa = 12.345, bb = 54321, foo = sin];
 609
 610 /* "rule issue" mailing list 2014-06-29 */
 611
 612 (matchdeclare (u, atom, fn, symbolp),
 613  defrule (ddint21, 'integrate(delta(u)*fn(u), u, minf, inf), fn(0)),
 614  ddint21('integrate(delta(u)*fn(u), u, minf, inf)));
 615 fn(0);
 616
 617 (kill (f), apply1 (1/(1 + 'integrate (f(x)*delta(x), x, minf, inf)), ddint21));
 618 1/(1 + f(0));
 619
 620 (kill (blurf),
 621  defrule (r1, 'integrate (blurf(u) + fn(u), u, minf, inf), fn(1)),
 622  r1 ('integrate (blurf(a) + g(a), a, minf, inf)));
 623 g(1);
 624
 625 /* rule for f interferes with function definition after kill
 626  * discussion on mailing list circa 2015-08-17: "trouble with GCL build"
 627  */
 628 (kill (all),
 629  matchdeclare (xx, integerp),
 630  tellsimp (f(xx), subst ('xx = xx, lambda ([a], a - xx))),
 631  kill (rules),
 632  f(n) := n + 1,
 633  translate(f),
 634  kill(f),
 635  f(y):=y+3,
 636  [fundef (f), f (10)]);
 637 [f(y) := y + 3, 13];
 638
 639 /* Verify that tellsimpafter rules are all applied.
 640  * This is a test for commit 801a0bb which creates one *AFTERFLAG per rule.
 641  * For good measure, verify that tellsimp and defrule work the same way.
 642  */
 643
 644 (simp:false,
 645  kill (f, g, h, i, j, rj1, rj2, rj3),
 646  tellsimpafter (f(1), f(0)),
 647  tellsimpafter (f(2), f(1)),
 648  tellsimpafter (f(3), f(2)),
 649  tellsimpafter (g(3), g(2)),
 650  tellsimpafter (g(2), g(1)),
 651  tellsimpafter (g(1), g(0)),
 652  tellsimp (h(1), h(0)),
 653  tellsimp (h(2), h(1)),
 654  tellsimp (h(3), h(2)),
 655  tellsimp (i(3), i(2)),
 656  tellsimp (i(2), i(1)),
 657  tellsimp (i(1), i(0)),
 658  defrule (rj1, j(1), j(0)),
 659  defrule (rj2, j(2), j(1)),
 660  defrule (rj3, j(3), j(2)),
 661  simp:true);
 662 true;
 663
 664 [f(1), f(2), f(3)];
 665 [f(0), f(0), f(0)];
 666
 667 [g(1), g(2), g(3)];
 668 [g(0), g(0), g(0)];
 669
 670 [h(1), h(2), h(3)];
 671 [h(0), h(0), h(0)];
 672
 673 [i(1), i(2), i(3)];
 674 [i(0), i(0), i(0)];
 675
 676 /* apply1 applies rj1 until it fails, then rj2, then rj3.
 677  * Since apply1 doesn't go back and try rj1 after rj2, or rj2 after rj3,
 678  * it's expected that the result of apply1 isn't maximally simplified.
 679  */
 680 apply1 ([j(1), j(2), j(3)], rj1, rj2, rj3);
 681 [j(0), j(1), j(2)];
 682
 683 /* apply1 with rules in reverse order does produce j(0) in each case here.
 684  */
 685 apply1 ([j(1), j(2), j(3)], rj3, rj2, rj1);
 686 [j(0), j(0), j(0)];
 687
 688 /* apply2 reapplies earlier rules if a later one succeeds.
 689  * So it's expected that the results will be maximally simplified,
 690  * with rules in either order.
 691  */
 692 apply2 ([j(1), j(2), j(3)], rj1, rj2, rj3);
 693 [j(0), j(0), j(0)];
 694
 695 apply2 ([j(1), j(2), j(3)], rj3, rj2, rj1);
 696 [j(0), j(0), j(0)];
 697
 698 /* applyb1, like apply1, doesn't reapply rules,
 699  * so it's expected results depend on the order of the rules.
 700  */
 701 applyb1 ([j(1), j(2), j(3)], rj1, rj2, rj3);
 702 [j(0), j(1), j(2)];
 703
 704 applyb1 ([j(1), j(2), j(3)], rj3, rj2, rj1);
 705 [j(0), j(0), j(0)];
 706
 707 /* Another test for commit 801a0bb. This time it's expected that *AFTERFLAG
 708  * prevents repeated application of the same tellsimpafter rule,
 709  * but a tellsimp rule is applied repeatedly (because it has no *AFTERFLAG).
 710  */
 711
 712 (kill(nn, k, l),
 713  matchdeclare (nn, lambda ([e], integerp(e) and e > 0)),
 714  tellsimpafter (k(nn), nn + k(nn - 1)),
 715  tellsimp (l(nn), nn + l(nn - 1)),
 716  0);
 717 0;
 718
 719 /* It's difficult to test the result of k(4) because k(3) + 4 is not maximally simplified
 720  * and the test mechanism applies simplification to both the actual and expected results.
 721  * See SIMPLE-EQUAL-P and APPROX-ALIKE in src/mload.lisp.
 722  */
 723 string (k(4));
 724 "k(3)+4";
 725
 726 /* On the other hand, l(0) is maximally simplified, so there's no difficulty here.
 727  */
 728 l(4);
 729 10 + l(0);
 730
 731 /* Another test for commit 801a0bb.
 732  * Tellsimpafter rules change operator from f, to g, to h, to i.
 733  */
 734
 735 (kill(f, g, h, i),
 736  simp:false,
 737  tellsimpafter(f(1), g(1)),
 738  tellsimpafter(g(1), h(1)),
 739  tellsimpafter(h(1), i(1)),
 740  simp:true);
 741 true;
 742
 743 f(1);
 744 i(1);