1/* A nice test of the translator would be to translate the entire test suite ... 2 * In the meantime here are some tests to verify some specific bugs are fixed. 3 */ 4 5(kill (all), 0); 60; 7 8/* SF [ 1728888 ] translator bugs: no mnot mprogn */ 9 10(foo (e,v) := block([vi], for vi in v while not(emptyp(e)) do (print(vi), e : rest(e)), e), 11 foo ([1, 2, 3], [a, b])); 12[3]; 13 14(translate (foo), ?funcall (foo, [1, 2, 3], [a, b])); 15[3]; 16 17/* simpler function featuring mprogn and mnot */ 18 19(bar (x) := (x : 2*x, x : 3*x, not (x < 100)), bar (3)); 20false; 21 22(translate (bar), ?funcall (bar, 3)); 23false; 24 25/* SF [ 1646525 ] no function mdoin */ 26 27(try_me(x) := block([acc : 0], for i in x while i > 5 do acc : acc + i, acc), 28 try_me ([10, 9, 8, 7, 6, 5, 4, 5, 6, 7, 8, 9, 10])); 2940; 30 31(translate (try_me), ?funcall (try_me, [10, 9, 8, 7, 6, 5, 4, 5, 6, 7, 8, 9, 10])); 3240; 33 34/* SF [ 1818645 ] Compiled maxima code containing $ARRAY gets a Lisp error. */ 35 36(test_array_comp (x) := 37 block ([abc, i], 38 array (abc, 3), 39 for i thru 3 do (abc[i]: i*i), 40 abc[3] : x, 41 [abc, abc[3], abc[2]]), 42 test_array_comp (100)); 43[abc, 100, 4]; 44 45(translate (test_array_comp), ?funcall (test_array_comp, 100)); 46[abc, 100, 4]; 47 48/* SF [ 545794 ] Local Array does not compile properly */ 49 50(trial (a) := 51 block ([myvar, i], 52 local(myvar), 53 array (myvar, 7), 54 for i : 0 thru 7 do myvar [i] : a^i, 55 [member (myvar, arrays), listarray (myvar)]), 56 trial (2)); 57[true, [1, 2, 4, 8, 16, 32, 64, 128]]; 58 59(translate (trial), ?funcall (trial, 2)); 60[true, [1, 2, 4, 8, 16, 32, 64, 128]]; 61 62/* Next test fails because local(myvar) in translated code doesn't clean up properties ... */ 63 64[member (myvar, arrays), errcatch (listarray (myvar))]; 65[false, []]; 66 67/* for loop variable not special 68 * reported to mailing list 2009-08-13 "Why won't this compile?" 69 */ 70 71(kill (foo1, bar1), 72 foo1 () := bar1 + 1, 73 baz1 (n) := block ([S : 0], for bar1:0 thru n - 1 do S : S + foo1 (), S), 74 translate (baz1), 75 baz1 (10)); 7655; 77 78/* original example */ 79 80(fun(A,b,s,VF,x,h):= block 81 ([Y], 82 Y[1]: x, 83 for i:2 thru s do 84 Y[i]: x + h*(sum(A[i,j]*VF(Y[j]),j,1,i-1)), 85 x: expand(x + h*sum(b[i]*VF(Y[i]),i,1,s))), 86 A: matrix([1,1],[1,1]), 87 b: [1,1], 88 0); 890; 90 91fun(A,b,2,f,[1,1],.01); 920.01*f(0.01*f([1,1])+[1,1])+0.01*f([1,1])+[1,1]$ 93 94(translate (fun), fun(A,b,2,f,[1,1],.01)); 950.01*f(0.01*f([1,1])+[1,1])+0.01*f([1,1])+[1,1]$ 96 97/* incorrect code emitted for call from translated function to untranslated 98 * SF bug # 2934064 "problem loading ezunits" 99 */ 100 101(f0001 (x) := [f0002 (x), f0003 (x)], 102 f0002 (x) := x, 103 f0003 (x) := x, 104 translate (f0002, f0001), 105 f0001 (1)); 106[1, 1]; 107 108(translate (f0003), f0001 (1)); 109[1, 1]; 110 111(compile (f0003), f0001 (1)); 112[1, 1]; 113 114(compile (f0003, f0002, f0001), f0001 (1)); 115[1, 1]; 116 117/* SF bug # 2938716 "too much evaluation in translated code" 118 */ 119 120(g0001 (x) := [g0002 (x), g0003 (x)], 121 g0002 (x) := x, 122 g0003 (x) := x, 123 translate (g0002, g0001), 124 kill (aa, bb, cc), 125 aa : 'bb, 126 bb : 'cc, 127 g0001 (aa)); 128[bb, bb]; 129 130(translate (g0003), g0001 (aa)); 131[bb, bb]; 132 133(compile (g0003), g0001 (aa)); 134[bb, bb]; 135 136(compile (g0003, g0002, g0001), g0001 (aa)); 137[bb, bb]; 138 139/* SF bug # 3035313 "some array references translated incorrectly" 140 */ 141 142(kill (aa1, aa3, bb1, bb3, cc1, cc3), 143 array (aa1, 15), 144 array (aa3, 12, 4, 6), 145 array (bb1, flonum, 15), 146 array (bb3, flonum, 5, 6, 7), 147 array (cc1, fixnum, 8), 148 array (cc3, fixnum, 6, 10, 4), 149 0); 1500; 151 152(kill (faa, gaa, fbb, gbb, fcc, gcc), 153 faa (n) := aa1[n] + aa3[n, n - 1, n - 2], 154 gaa (n) := (aa1[n] : 123, aa3[n, n - 1, n - 2] : 321), 155 fbb (n) := bb1[n] + bb3[n, n - 1, n - 2], 156 gbb (n) := (bb1[n] : 123, bb3[n, n - 1, n - 2] : 321), 157 fcc (n) := cc1[n] + cc3[n, n - 1, n - 2], 158 gcc (n) := (cc1[n] : 123, cc3[n, n - 1, n - 2] : 321), 159 0); 1600; 161 162[gaa (4), gbb (4), gcc (4)]; 163[321, 321, 321]; 164 165[faa (4), fbb (4), fcc (4)]; 166[444, 444, 444]; 167 168translate (faa, gaa, fbb, gbb, fcc, gcc); 169[faa, gaa, fbb, gbb, fcc, gcc]; 170 171[gaa (4), gbb (4), gcc (4)]; 172[321, 321, 321]; 173 174[faa (4), fbb (4), fcc (4)]; 175[444, 444, 444]; 176 177compile (faa, gaa, fbb, gbb, fcc, gcc); 178[faa, gaa, fbb, gbb, fcc, gcc]; 179 180[gaa (4), gbb (4), gcc (4)]; 181[321, 321, 321]; 182 183[faa (4), fbb (4), fcc (4)]; 184[444, 444, 444]; 185 186/* try same stuff again w/ undeclared arrays ... 187 * no type spec => only one kind of array 188 */ 189 190(kill (aa1, aa3, bb1, bb3, cc1, cc3), 191 ?fmakunbound (faa), 192 ?fmakunbound (fbb), 193 [gaa (4), faa (4)]); 194[321, 444]; 195 196(translate (faa, gaa), [gaa (4), faa (4)]); 197[321, 444]; 198 199(compile (faa, gaa), [gaa (4), faa (4)]); 200[321, 444]; 201 202/* try same stuff again w/ Lisp arrays */ 203 204(kill (aa1, aa3, bb1, bb3, cc1, cc3), 205 map (?fmakunbound, [faa, fbb, fcc, gaa, gbb, gcc]), 206 aa1 : make_array (any, 15), 207 aa3 : make_array (any, 12, 4, 6), 208 bb1 : make_array (flonum, 15), 209 bb3 : make_array (flonum, 5, 6, 7), 210 cc1 : make_array (fixnum, 8), 211 cc3 : make_array (fixnum, 6, 10, 4), 212 0); 2130; 214 215[gaa (4), gbb (4), gcc (4)]; 216[321, 321, 321]; 217 218[faa (4), fbb (4), fcc (4)]; 219[444, 444, 444]; 220 221translate (faa, gaa, fbb, gbb, fcc, gcc); 222[faa, gaa, fbb, gbb, fcc, gcc]; 223 224[gaa (4), gbb (4), gcc (4)]; 225[321, 321, 321]; 226 227[faa (4), fbb (4), fcc (4)]; 228[444, 444, 444]; 229 230compile (faa, gaa, fbb, gbb, fcc, gcc); 231[faa, gaa, fbb, gbb, fcc, gcc]; 232 233[gaa (4), gbb (4), gcc (4)]; 234[321, 321, 321]; 235 236[faa (4), fbb (4), fcc (4)]; 237[444, 444, 444]; 238 239/* SF bug # 2569: "translate rat(1,x) and rat([1]) incorrect" */ 240 241(kill (f), f () := rat (x, x), translate (f), f ()); 242''(rat (x, x)); 243 244(kill (f), f () := rat ([1]), translate (f), f ()); 245''(rat ([1])); 246 247(kill (foo, y1a, y1b, y2a, y2b), 248 foo(x) := block (mode_declare (x, float), 249 [tanh (x), tan (x), sech (x), sec (x), acos (x), acot (x), sin (x), 250 acsc (x), asinh (x), acsch (x), cosh (x), coth (x), realpart (x), 251 asec (x), asin (x), erf (x), log (x), cos (x), cot (x), csc (x), 252 sinh (x), csch (x)]), 253 0); 2540; 255 256y1a : foo (0.5); 257[.4621171572600097,.5463024898437905,0.886818883970074,1.139493927324549, 258 1.047197551196597,1.107148717794091,0.479425538604203, 259 1.570796326794897-1.316957896924817*%i,.4812118250596035,1.44363547517881, 260 1.127625965206381,2.163953413738653,0.5,1.316957896924817*%i, 261 0.523598775598299,.5204998778130465,-.6931471805599453,.8775825618903728, 262 1.830487721712452,2.085829642933488,.5210953054937474,1.919034751334944]$ 263 264y1b : foo (1.5); 265[.9051482536448664,14.10141994717172,.4250960349422805,14.1368329029699, 266 .9624236501192069*%i,.5880026035475675,.9974949866040544,.7297276562269662, 267 1.194763217287109,.6251451172504168,2.352409615243247,1.104791392982512,1.5, 268 .8410686705679303,1.570796326794897-.9624236501192069*%i,.9661051464753108, 269 .4054651081081644,0.0707372016677029,.07091484430265245,1.002511304246725, 270 2.129279455094817,.4696424405952246]$ 271 272(translate (foo), y2a : foo (0.5), y2b : foo (1.5), 0); 2730; 274 275is (y1a = y2a); 276true; 277 278is (y1b = y2b); 279true; 280 281/* verify that save/compfile/compile_file/translate_file preserves upper/lower case in symbol names */ 282 283/* save */ 284 285(kill (all), 286 foo (x) := my_foo * x, 287 Foo (x) := my_Foo * x, 288 FOO (x) := my_FOO * x, 289 [my_foo, my_Foo, my_FOO] : [123, 456, 789], 290 results : [foo (2), Foo (3), FOO (4)], 291 my_test () := is (results = [2*123, 3*456, 4*789]), 292 lisp_name : ssubst ("_", " ", build_info()@lisp_name), 293 lisp_filename : sconcat (maxima_tempdir, "/tmp-rtest_translator-save-", lisp_name, ".lisp"), 294 save (lisp_filename, values, functions), 295 kill (allbut (lisp_filename)), 296 load (lisp_filename), 297 my_test ()); 298true; 299 300/* compfile */ 301 302(kill (all), 303 foo (x) := my_foo * x, 304 Foo (x) := my_Foo * x, 305 FOO (x) := my_FOO * x, 306 lisp_name : ssubst ("_", " ", build_info()@lisp_name), 307 lisp_filename : sconcat (maxima_tempdir, "/tmp-rtest_translator-compfile-", lisp_name, ".lisp"), 308 compfile (lisp_filename, functions), 309 kill (functions), 310 load (lisp_filename), 311 [my_foo, my_Foo, my_FOO] : [123, 456, 789], 312 results : [foo (2), Foo (3), FOO (4)], 313 my_test () := is (results = [2*123, 3*456, 4*789]), 314 my_test ()); 315true; 316 317/* compile_file */ 318 319/* skip this test (and fail) if Lisp = ECL because stream i/o causes "stack smashing" error 320 * see: https://sourceforge.net/p/maxima/bugs/3291/ 321 */ 322if build_info()@lisp_name # "ECL" then 323(kill (all), 324 lisp_name : ssubst ("_", " ", build_info()@lisp_name), 325 maxima_filename : sconcat (maxima_tempdir, "/tmp-rtest_translator-compile_file-", lisp_name, ".mac"), 326 fasl_filename : sconcat (maxima_tempdir, "/tmp-rtest_translator-compile_file-", lisp_name, ".fasl"), 327 lisp_filename : sconcat (maxima_tempdir, "/tmp-rtest_translator-compile_file-", lisp_name, ".LISP"), 328 maxima_output : openw (maxima_filename), 329 maxima_content : 330"foo (x) := my_foo * x; 331Foo (x) := my_Foo * x; 332FOO (x) := my_FOO * x; 333[my_foo, my_Foo, my_FOO] : [123, 456, 789]; 334results : [foo (2), Foo (3), FOO (4)]; 335my_test () := is (results = [2*123, 3*456, 4*789]);", 336 printf (maxima_output, maxima_content), 337 close (maxima_output), 338 compile_file (maxima_filename, fasl_filename, lisp_filename), 339 kill (allbut (lisp_filename)), 340 load (lisp_filename), 341 my_test ()); 342true; 343 344/* translate_file */ 345 346/* skip this test (and fail) if Lisp = ECL because stream i/o causes "stack smashing" error 347 * see: https://sourceforge.net/p/maxima/bugs/3291/ 348 */ 349if build_info()@lisp_name # "ECL" then 350(kill (all), 351 lisp_name : ssubst ("_", " ", build_info()@lisp_name), 352 maxima_filename : sconcat (maxima_tempdir, "/tmp-rtest_translator-translate_file-", lisp_name, ".mac"), 353 lisp_filename : sconcat (maxima_tempdir, "/tmp-rtest_translator-translate_file-", lisp_name, ".LISP"), 354 maxima_output : openw (maxima_filename), 355 maxima_content : 356"foo (x) := my_foo * x; 357Foo (x) := my_Foo * x; 358FOO (x) := my_FOO * x; 359[my_foo, my_Foo, my_FOO] : [123, 456, 789]; 360results : [foo (2), Foo (3), FOO (4)]; 361my_test () := is (results = [2*123, 3*456, 4*789]);", 362 printf (maxima_output, maxima_content), 363 close (maxima_output), 364 translate_file (maxima_filename, lisp_filename), 365 kill (allbut (lisp_filename)), 366 load (lisp_filename), 367 my_test ()); 368true; 369 370/* Bug 2934: 371 372 Translating a literal exponent that comes out as a float shouldn't 373 produce assigned type any. This test runs the translation for a 374 trivial function that triggered the bug then looks in the unlisp 375 file (which contains messages from the translator) and checks that 376 there aren't any warnings. 377*/ 378/* skip this test (and fail) if Lisp = ECL because stream i/o causes "stack smashing" error 379 * see: https://sourceforge.net/p/maxima/bugs/3291/ 380 */ 381if build_info()@lisp_name # "ECL" then 382(kill (all), 383 lisp_name : ssubst ("_", " ", build_info()@lisp_name), 384 basename: sconcat (maxima_tempdir, "/tmp-rtest_translator-2934-", lisp_name), 385 maxima_filename : sconcat (basename, ".mac"), 386 lisp_filename : sconcat (basename, ".LISP"), 387 maxima_output : openw (maxima_filename), 388 maxima_content : "f () := block([y], mode_declare(y,float), y: 3^0.33, y)$", 389 printf (maxima_output, maxima_content), 390 close (maxima_output), 391 translate_file (maxima_filename, lisp_filename), 392 kill (allbut(basename)), 393 /* Any warning messages end up at .UNLISP */ 394 block ([unlisp: openr (sconcat (basename, ".UNLISP")), 395 line, acc: []], 396 while stringp (line: readline(unlisp)) do 397 if is ("warning" = split(line, ":")[1]) then push(line, acc), 398 acc)); 399[]$ 400 401/* makelist translated incorrectly 402 * SF bug #3083: "Error on compiling a working maxima function" 403 */ 404 405(kill(all), 406 f1(n) := makelist (1, n), 407 f2(n) := makelist (i^2, i, n), 408 f3(l) := makelist (i^3, i, l), 409 f4(n) := makelist (i^4, i, 1, n), 410 f5(m, n) := makelist (i^5, i, 1, n, m), 411 translate(f1, f2, f3, f4, f5), 412 0); 4130; 414 415f1(5); 416[1,1,1,1,1]; 417 418f2(5); 419[1, 4, 9, 16, 25]; 420 421f3([1,2,3]); 422[1, 8, 27]; 423 424f4(4); 425[1, 16, 81, 256]; 426 427f5(2, 10); 428[1, 243, 3125, 16807, 59049]; 429 430/* original function from bug report */ 431 432(ordersort(lis,vars,oper):=block([negsumdispflag:false,liss:lis,varlist:vars,temp], /*Does lexicographical sort */ 433 for i:1 thru length(varlist) do ( 434 for j:1 thru i do ( 435 liss:sort(liss,lambda([x,y],apply("and",map(oper,makelist(part(x,2)[k],k,1,i) 436 ,makelist(part(y,2)[k],k,1,i))))) 437 )),liss), 438 translate (ordersort)); /* 'translate' doesn't trigger an error, so check return value */ 439[ordersort]; 440 441[member ('transfun, properties(ordersort)), 442 ordersort([[-7,[0,2,1]],[3,[1,2,1]],[1,[0,4,1]],[6,[4,3,3]],[6,[4,4,3]],[-7,[3,5,4]],[2,[0,0,5]],[-10,[2,2,5]],[-10,[3,4,7]],[7,[3,8,9]]],[x,y,z],">=")]; 443[true, [[6,[4,4,3]],[6,[4,3,3]],[7,[3,8,9]],[-7,[3,5,4]],[-10,[3,4,7]],[-10,[2,2,5]],[3,[1,2,1]],[1,[0,4,1]],[-7,[0,2,1]],[2,[0,0,5]]]]; 444 445/* 'define' translated incorrectly, reported to mailing list circa 2017-01-24 */ 446 447(kill(foo, bar, baz, quux, mumble, blurf, umm, f, x, y), 448 foo(y) := define(bar(x), x + y), 449 baz(f, y) := define(funmake(f, [x]), x + y), 450 quux() := (mumble(x) := 1 + x), 451 [foo(10), baz(blurf, 20), quux()]); 452/* note that results match because rhs of ":=" isn't simplified */ 453[bar(x) := 10 + x, blurf(x) := 20 + x, mumble(x) := 1 + x]; 454 455[bar(5), blurf(5), mumble(5)]; 456[15, 25, 6]; 457 458(kill(bar, blurf, mumble), 459 translate(foo, baz, quux), 460 [foo(11), baz(umm, 21), quux()]); 461/* note that results match because rhs of ":=" isn't simplified */ 462[bar(x) := 11 + x, umm(x) := 21 + x, mumble(x) := 1 + x]; 463 464makelist (is (x # false), x, map (?fboundp, [foo, baz, quux])); /* test for generalized Boolean value */ 465[true, true, true]; 466 467[bar(5), umm(5), mumble(5)]; 468[16, 26, 6]; 469 470/* mailing list 2017-03-04: "An example that is broken by compile()" 471 * translated code tickles a bug elsewhere (bug not in translator) 472 */ 473 474(kill(fun, trigfunc, t1), 475 fun():=block([trigfunc], 476 trigfunc:lambda([cur],cur>t1), 477 apply('trigfunc,[1])), 478 0); 4790; 480 481/* I (Robert Dodier) believe this result should be trigfunc(1), 482 * but, in any event, interpreted and compiled code should agree. 483 * But if MAPPLY1 is ever changed, we can adjust these results. 484 */ 485fun(); 4861 > t1; 487 488(compile(fun), fun()); 4891 > t1; 490 491(kill(fun, trigfunc, t1), 492 fun():=block([trigfunc], 493 trigfunc:lambda([cur],cur>t1), 494 apply(trigfunc,[1])), 495 0); 4960; 497 498fun(); 4991 > t1; 500 501(compile(fun), fun()); 5021 > t1; 503 504/* Verify that we catch malformed lambda expressions during translation. 505 * More checks need to be added to the translator and more tests need to 506 * be added here. 507 */ 508 509/* no parameter list */ 510(kill (f), 511 f () := lambda (), 512 translate (f))$ 513[]; 514 515/* empty body */ 516(kill (f), 517 f () := lambda ([x]), 518 translate (f))$ 519[]; 520 521/* non-symbol in parameter list */ 522(kill (f), 523 f () := lambda ([42], 'foo), 524 translate (f))$ 525[]; 526 527/* misplaced "rest" parameter */ 528(kill (f), 529 f () := lambda ([[l], x], 'foo), 530 translate (f))$ 531[]; 532 533/* invalid "rest" parameter */ 534(kill (f), 535 f () := lambda ([[l1, l2]], 'foo), 536 translate (f))$ 537[]; 538 539/* attempting to bind a constant; 540 * now OK, after commit 0517895 541 */ 542block ([c, f], 543 local (c, f), 544 declare (c, constant), 545 f () := lambda ([c], c), 546 translate (f))$ 547[f]; 548 549/* Verify that parameter/variable lists cannot contain duplicate variables. 550 * 551 * We only test a couple of cases here. Many more tests for non-translated 552 * code are in rtest2. Do we want to test them all here as well? 553 */ 554 555(kill(f), 556 f () := lambda ([x, [x]], x), 557 translate (f))$ 558[]; 559 560(kill(f), 561 f () := block ([x, x:'foo], x), 562 translate (f))$ 563[]; 564 565/* ensure that a null OPERATORS property doesn't interfere with 566 * translation of local variable used as a function name. 567 * This is the bug that caused failures in rtest_fractals when executed after run_testsuite. 568 */ 569 570(kill(aa, foobarbaz, mumbleblurf, hhh), 571 matchdeclare (aa, all), 572 tellsimp (mumbleblurf(aa), 1 - aa), 573 kill (mumbleblurf), /* as of 2018-01-28, this leaves (OPERATORS NIL) in property list */ 574 hhh(mumbleblurf, u) := mumbleblurf(u), 575 foobarbaz(x) := 100 + x, 576 translate (hhh), 577 hhh (foobarbaz, 11)); 578111; 579 580/* SF bug report #3402: "Unbinding defined variable generates error in compiled functions" */ 581 582define_variable (zorble, 0, fixnum); 5830; 584 585(kill(f), f() := block ([zorble], 42), f()); 58642; 587 588translate(f); 589[f]; 590 591f(); 59242; 593 594/* bug reported to mailing list 2018-12-03: "error in compiling function with global variable" */ 595 596(test_f():= block( [a,b,c,d], niceindicespref:[a,b,c,d], disp("ciao"), return() ), 597 0); 5980; 599 600(test_f (), niceindicespref); 601[a,b,c,d]; 602 603(reset (niceindicespref), 604 niceindicespref); 605[i,j,k,l,m,n]; 606 607(translate (test_f), 608 test_f (), 609 niceindicespref); 610[a,b,c,d]; 611 612(reset (niceindicespref), 0); 6130; 614 615/* additional tests with variables which have ASSIGN property */ 616 617(set_error_stuff_permanently () := 618 block (error_syms : '[myerr1, myerr2, myerr3], error_size : 40), 619 set_error_stuff_temporarily() := 620 block([error_syms : '[myerror1, myerror2, myerror3], error_size : 55], 621 [error_syms, error_size]), 622 0); 6230; 624 625(reset (error_syms, error_size), 626 set_error_stuff_permanently (), 627 [error_syms, error_size]); 628[[myerr1, myerr2, myerr3], 40]; 629 630(reset (error_syms, error_size), 631 translate (set_error_stuff_permanently), 632 set_error_stuff_permanently (), 633 [error_syms, error_size]); 634[[myerr1, myerr2, myerr3], 40]; 635 636(reset (error_syms, error_size), 637 set_error_stuff_temporarily()); 638[[myerror1, myerror2, myerror3], 55]; 639 640[error_syms, error_size]; 641[[errexp1, errexp2, errexp3], 60]; 642 643(translate (set_error_stuff_temporarily), 644 set_error_stuff_temporarily()); 645[[myerror1, myerror2, myerror3], 55]; 646 647[error_syms, error_size]; 648[[errexp1, errexp2, errexp3], 60]; 649 650(kill(all), reset(), 0); 6510; 652 653/* SF bug #3412: "Bug when translating functions that contain an \"if\" (in my case an implicit if)" */ 654 655(f(x):=if cabs(1/(x+1)) < 1 then 1/(x+1) else 1, 656 f(x + %i*y)); 657if 1/sqrt(y^2+(x+1)^2) < 1 then 1/(%i*y+x+1) else 1; 658 659makelist (f(xy[1] + %i*xy[2]), xy, [[0, 0], [0, 1], [1, 1], [1, 0], [0, 2], [2, 2], [2, 0]]); 660[1, 1/(%i+1), 1/(%i+2), 1/2, 1/(2*%i+1), 1/(2*%i+3), 1/3]$ 661 662(compile (f), 663 errcatch (f(x + %i*y))); 664[]; 665 666'(f(x + %i*y)); 667f(x + %i*y); 668 669makelist (f(xy[1] + %i*xy[2]), xy, [[0, 0], [0, 1], [1, 1], [1, 0], [0, 2], [2, 2], [2, 0]]); 670[1, 1/(%i+1), 1/(%i+2), 1/2, 1/(2*%i+1), 1/(2*%i+3), 1/3]$ 671 672(if draw_version = 'draw_version then load (draw), 673 draw3d(contour='map, 674 proportional_axes=xy, 675 nticks=100, 676 contour_levels=20, 677 explicit('(f(x+%i*y)),x,-2,2,y,-2,2)), 678 0); 6790; 680 681/* nested if example -- note top-level "if" doesn't have an "else" clause, so the result is sometimes 'false' */ 682 683(g(a, b, c) := if a + b > c 684 then (if a > c 685 then (if b > c 686 then (a + b + c) 687 elseif b > c/2 688 then (a - b - c) 689 else (b - a - c)) 690 else (a/2)), 691 0); 6920; 693 694(aa: [3,9/4,5/4,11/4,1,0,9/4,1/4,5/2,9/4,3,5/2], 695 bb: [3/2,3,1/4,3/4,5/2,7/4,5/2,3/4,1/2,3,13/4,7/2], 696 cc: [7/2,15/4,5/2,5/4,15/4,1,1/4,7/4,2,11/4,1/4,7/4], 697 map (g, aa, bb, cc)); 698[3/2,9/8,false,3/4,false,0,5,false,-4,9/8,13/2,31/4]$ 699 700(translate (g), 701 map (g, aa, bb, cc)); 702[3/2,9/8,false,3/4,false,0,5,false,-4,9/8,13/2,31/4]$ 703 704errcatch (g(1, 1, z)); 705[]; 706 707/* SF bug #3556: "5.43.0 translate / compile error" 708 * Ensure that "if" within lambda is translated correctly. 709 * The fix for #3412 tickled this bug. 710 */ 711 712(kill (f), 713 f(x, m) := map (lambda ([u], if m > 0 then u^m), [x, 2*x, 3*x]), 714 0); 7150; 716 717is (?fboundp (f) # false); 718false; 719 720(kill (y), 721 [f(y, 2), f(y, -2)]); 722[[y^2, 4*y^2, 9*y^2], [false, false, false]]; 723 724(kill (n), 725 errcatch (f(10, n))); 726/* ensure that conditional expressions get simplified to expunge $FALSE ... sigh. */ 727''([[if n > 0 then 10^n, if n > 0 then 20^n, if n > 0 then 30^n]]); 728 729translate (f); 730[f]; 731 732is (?fboundp (f) # false); /* test for generalized Boolean value */ 733true; 734 735[f(y, 2), f(y, -2)]; 736[[y^2, 4*y^2, 9*y^2], [false, false, false]]; 737 738errcatch (f(10, n)); 739[]; 740