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