/* A nice test of the translator would be to translate the entire test suite ...
 * In the meantime here are some tests to verify some specific bugs are fixed.
 */

(kill (all), 0);
0;

/* SF [ 1728888 ] translator bugs: no mnot mprogn */

(foo (e,v) := block([vi], for vi in v while not(emptyp(e)) do (print(vi), e : rest(e)), e),
 foo ([1, 2, 3], [a, b]));
[3];

(translate (foo), ?funcall (foo, [1, 2, 3], [a, b]));
[3];

/* simpler function featuring mprogn and mnot */

(bar (x) := (x : 2*x, x : 3*x, not (x < 100)), bar (3));
false;

(translate (bar), ?funcall (bar, 3));
false;

/* SF [ 1646525 ] no function mdoin */

(try_me(x) := block([acc : 0], for i in x while i > 5 do acc : acc + i, acc),
 try_me ([10, 9, 8, 7, 6, 5, 4, 5, 6, 7, 8, 9, 10]));
40;

(translate (try_me), ?funcall (try_me, [10, 9, 8, 7, 6, 5, 4, 5, 6, 7, 8, 9, 10]));
40;

/* SF [ 1818645 ] Compiled maxima code containing $ARRAY gets a Lisp error. */

(test_array_comp (x) :=
  block ([abc, i],
    array (abc, 3),
    for i thru 3 do (abc[i]: i*i),
    abc[3] : x, 
    [abc, abc[3], abc[2]]),
  test_array_comp (100));
[abc, 100, 4];

(translate (test_array_comp), ?funcall (test_array_comp, 100));
[abc, 100, 4];

/* SF [ 545794 ] Local Array does not compile properly */

(trial (a) :=
  block ([myvar, i],
    local(myvar),
    array (myvar, 7),
    for i : 0 thru 7 do myvar [i] : a^i,
    [member (myvar, arrays), listarray (myvar)]),
 trial (2));
[true, [1, 2, 4, 8, 16, 32, 64, 128]];

(translate (trial), ?funcall (trial, 2));
[true, [1, 2, 4, 8, 16, 32, 64, 128]];

/* Next test fails because local(myvar) in translated code doesn't clean up properties ... */

[member (myvar, arrays), errcatch (listarray (myvar))];
[false, []];

/* for loop variable not special
 * reported to mailing list 2009-08-13 "Why won't this compile?"
 */

(kill (foo1, bar1),
 foo1 () := bar1 + 1,
 baz1 (n) := block ([S : 0], for bar1:0 thru n - 1 do S : S + foo1 (), S),
 translate (baz1),
 baz1 (10));
55;

/* original example */

(fun(A,b,s,VF,x,h):= block
 ([Y],
   Y[1]:  x,
   for i:2 thru s do
    Y[i]:  x + h*(sum(A[i,j]*VF(Y[j]),j,1,i-1)),
   x: expand(x + h*sum(b[i]*VF(Y[i]),i,1,s))),
  A: matrix([1,1],[1,1]),
  b: [1,1],
 0);
0;

fun(A,b,2,f,[1,1],.01);
0.01*f(0.01*f([1,1])+[1,1])+0.01*f([1,1])+[1,1]$

(translate (fun), fun(A,b,2,f,[1,1],.01));
0.01*f(0.01*f([1,1])+[1,1])+0.01*f([1,1])+[1,1]$

/* incorrect code emitted for call from translated function to untranslated
 * SF bug # 2934064 "problem loading ezunits"
 */

(f0001 (x) := [f0002 (x), f0003 (x)],
 f0002 (x) := x,
 f0003 (x) := x,
 translate (f0002, f0001),
 f0001 (1));
[1, 1];

(translate (f0003), f0001 (1));
[1, 1];

(compile (f0003), f0001 (1));
[1, 1];

(compile (f0003, f0002, f0001), f0001 (1));
[1, 1];

/* SF bug # 2938716 "too much evaluation in translated code"
 */

(g0001 (x) := [g0002 (x), g0003 (x)],
 g0002 (x) := x,
 g0003 (x) := x,
 translate (g0002, g0001),
 kill (aa, bb, cc),
 aa : 'bb,
 bb : 'cc,
 g0001 (aa));
[bb, bb];

(translate (g0003), g0001 (aa));
[bb, bb];

(compile (g0003), g0001 (aa));
[bb, bb];

(compile (g0003, g0002, g0001), g0001 (aa));
[bb, bb];

/* SF bug # 3035313 "some array references translated incorrectly"
 */

(kill (aa1, aa3, bb1, bb3, cc1, cc3),
 array (aa1, 15),
 array (aa3, 12, 4, 6),
 array (bb1, flonum, 15),
 array (bb3, flonum, 5, 6, 7),
 array (cc1, fixnum, 8),
 array (cc3, fixnum, 6, 10, 4),
 0);
0;

(kill (faa, gaa, fbb, gbb, fcc, gcc),
 faa (n) := aa1[n] + aa3[n, n - 1, n - 2],
 gaa (n) := (aa1[n] : 123, aa3[n, n - 1, n - 2] : 321),
 fbb (n) := bb1[n] + bb3[n, n - 1, n - 2],
 gbb (n) := (bb1[n] : 123, bb3[n, n - 1, n - 2] : 321),
 fcc (n) := cc1[n] + cc3[n, n - 1, n - 2],
 gcc (n) := (cc1[n] : 123, cc3[n, n - 1, n - 2] : 321),
 0);
0;

[gaa (4), gbb (4), gcc (4)];
[321, 321, 321];

[faa (4), fbb (4), fcc (4)];
[444, 444, 444];

translate (faa, gaa, fbb, gbb, fcc, gcc);
[faa, gaa, fbb, gbb, fcc, gcc];

[gaa (4), gbb (4), gcc (4)];
[321, 321, 321];

[faa (4), fbb (4), fcc (4)];
[444, 444, 444];

compile (faa, gaa, fbb, gbb, fcc, gcc);
[faa, gaa, fbb, gbb, fcc, gcc];

[gaa (4), gbb (4), gcc (4)];
[321, 321, 321];

[faa (4), fbb (4), fcc (4)];
[444, 444, 444];

/* try same stuff again w/ undeclared arrays ...
 * no type spec => only one kind of array
 */

(kill (aa1, aa3, bb1, bb3, cc1, cc3),
 ?fmakunbound (faa),
 ?fmakunbound (fbb),
 [gaa (4), faa (4)]);
[321, 444];

(translate (faa, gaa), [gaa (4), faa (4)]);
[321, 444];

(compile (faa, gaa), [gaa (4), faa (4)]);
[321, 444];

/* try same stuff again w/ Lisp arrays */

(kill (aa1, aa3, bb1, bb3, cc1, cc3),
 map (?fmakunbound, [faa, fbb, fcc, gaa, gbb, gcc]),
 aa1 : make_array (any, 15),
 aa3 : make_array (any, 12, 4, 6),
 bb1 : make_array (flonum, 15),
 bb3 : make_array (flonum, 5, 6, 7),
 cc1 : make_array (fixnum, 8),
 cc3 : make_array (fixnum, 6, 10, 4),
 0);
0;

[gaa (4), gbb (4), gcc (4)];
[321, 321, 321];

[faa (4), fbb (4), fcc (4)];
[444, 444, 444];

translate (faa, gaa, fbb, gbb, fcc, gcc);
[faa, gaa, fbb, gbb, fcc, gcc];

[gaa (4), gbb (4), gcc (4)];
[321, 321, 321];

[faa (4), fbb (4), fcc (4)];
[444, 444, 444];

compile (faa, gaa, fbb, gbb, fcc, gcc);
[faa, gaa, fbb, gbb, fcc, gcc];

[gaa (4), gbb (4), gcc (4)];
[321, 321, 321];

[faa (4), fbb (4), fcc (4)];
[444, 444, 444];

/* SF bug # 2569: "translate rat(1,x) and rat([1]) incorrect" */

(kill (f), f () := rat (x, x), translate (f), f ());
''(rat (x, x));

(kill (f), f () := rat ([1]), translate (f), f ());
''(rat ([1]));

(kill (foo, y1a, y1b, y2a, y2b), 
  foo(x) := block (mode_declare (x, float),
     [tanh (x), tan (x), sech (x), sec (x), acos (x), acot (x), sin (x),
      acsc (x), asinh (x), acsch (x), cosh (x), coth (x), realpart (x),
      asec (x), asin (x), erf (x), log (x), cos (x), cot (x), csc (x),
      sinh (x), csch (x), sqrt (x), exp (x)]),
  0);
0;

y1a : foo (0.5);
[.4621171572600097,.5463024898437905,0.886818883970074,1.139493927324549,
 1.047197551196597,1.107148717794091,0.479425538604203,
 1.570796326794897-1.316957896924817*%i,.4812118250596035,1.44363547517881,
 1.127625965206381,2.163953413738653,0.5,1.316957896924817*%i,
 0.523598775598299,.5204998778130465,-.6931471805599453,.8775825618903728,
 1.830487721712452,2.085829642933488,.5210953054937474,1.919034751334944,
 .7071067811865476,1.648721270700128]$

y1b : foo (1.5);
[.9051482536448664,14.10141994717172,.4250960349422805,14.1368329029699,
 .9624236501192069*%i,.5880026035475675,.9974949866040544,.7297276562269662,
 1.194763217287109,.6251451172504168,2.352409615243247,1.104791392982512,1.5,
 .8410686705679303,1.570796326794897-.9624236501192069*%i,.9661051464753108,
 .4054651081081644,0.0707372016677029,.07091484430265245,1.002511304246725,
 2.129279455094817,.4696424405952246,1.224744871391589,4.481689070338065]$

y1c : foo (1.0);
[0.7615941559557649,1.557407724654902,0.6480542736638855,
 1.850815717680925,0.0,0.7853981633974483,0.8414709848078965,
 1.570796326794897,0.881373587019543,0.881373587019543,
 1.543080634815244,1.313035285499331,1.0,0.0,1.570796326794897,
 0.8427007929497148,0.0,0.5403023058681398,0.6420926159343306,
 1.188395105778121,1.175201193643801,0.8509181282393216,1.0,
 2.718281828459045]$

(translate (foo), y2a : foo (0.5), y2b : foo (1.5), 0);
0;

is (y1a = y2a);
true;

is (y1b = y2b);
true;

block ([tr_float_can_branch_complex : false],
  translate (foo),
  y2c : foo (1.0),
  0);
0;

is (y1c = y2c);
true;

/* verify that save/compfile/compile_file/translate_file preserves upper/lower case in symbol names */

/* save */

(kill (all),
 foo (x) := my_foo * x,
 Foo (x) := my_Foo * x,
 FOO (x) := my_FOO * x,
 [my_foo, my_Foo, my_FOO] : [123, 456, 789],
 results : [foo (2), Foo (3), FOO (4)],
 my_test () := is (results = [2*123, 3*456, 4*789]),
 lisp_name : ssubst ("_", " ", build_info()@lisp_name),
 lisp_filename : sconcat (maxima_tempdir, "/tmp-rtest_translator-save-", lisp_name, ".lisp"),
 save (lisp_filename, values, functions),
 kill (allbut (lisp_filename)),
 load (lisp_filename),
 my_test ());
true;

/* compfile */

(kill (all),
 foo (x) := my_foo * x,
 Foo (x) := my_Foo * x,
 FOO (x) := my_FOO * x,
 lisp_name : ssubst ("_", " ", build_info()@lisp_name),
 lisp_filename : sconcat (maxima_tempdir, "/tmp-rtest_translator-compfile-", lisp_name, ".lisp"),
 compfile (lisp_filename, functions),
 kill (functions), 
 load (lisp_filename),
 [my_foo, my_Foo, my_FOO] : [123, 456, 789],
 results : [foo (2), Foo (3), FOO (4)],
 my_test () := is (results = [2*123, 3*456, 4*789]),
 my_test ());
true;
 
/* compile_file */

/* skip this test (and fail) if Lisp = ECL because stream i/o causes "stack smashing" error
 * see: https://sourceforge.net/p/maxima/bugs/3291/
 */
if build_info()@lisp_name # "ECL" then
(kill (all),
 lisp_name : ssubst ("_", " ", build_info()@lisp_name),
 maxima_filename : sconcat (maxima_tempdir, "/tmp-rtest_translator-compile_file-", lisp_name, ".mac"),
 fasl_filename : sconcat (maxima_tempdir, "/tmp-rtest_translator-compile_file-", lisp_name, ".fasl"),
 lisp_filename : sconcat (maxima_tempdir, "/tmp-rtest_translator-compile_file-", lisp_name, ".LISP"),
 maxima_output : openw (maxima_filename),
 maxima_content :
"foo (x) := my_foo * x;
Foo (x) := my_Foo * x;
FOO (x) := my_FOO * x;
[my_foo, my_Foo, my_FOO] : [123, 456, 789];
results : [foo (2), Foo (3), FOO (4)];
my_test () := is (results = [2*123, 3*456, 4*789]);",
 printf (maxima_output, maxima_content),
 close (maxima_output),
 compile_file (maxima_filename, fasl_filename, lisp_filename),
 kill (allbut (lisp_filename)),
 load (lisp_filename),
 my_test ());
true;

/* translate_file */

/* skip this test (and fail) if Lisp = ECL because stream i/o causes "stack smashing" error
 * see: https://sourceforge.net/p/maxima/bugs/3291/
 */
if build_info()@lisp_name # "ECL" then
(kill (all),
 lisp_name : ssubst ("_", " ", build_info()@lisp_name),
 maxima_filename : sconcat (maxima_tempdir, "/tmp-rtest_translator-translate_file-", lisp_name, ".mac"),
 lisp_filename : sconcat (maxima_tempdir, "/tmp-rtest_translator-translate_file-", lisp_name, ".LISP"),
 maxima_output : openw (maxima_filename),
 maxima_content :
"foo (x) := my_foo * x;
Foo (x) := my_Foo * x;
FOO (x) := my_FOO * x;
[my_foo, my_Foo, my_FOO] : [123, 456, 789];
results : [foo (2), Foo (3), FOO (4)];
my_test () := is (results = [2*123, 3*456, 4*789]);",
 printf (maxima_output, maxima_content),
 close (maxima_output),
 translate_file (maxima_filename, lisp_filename),
 kill (allbut (lisp_filename)),
 load (lisp_filename),
 my_test ());
true;

/* Bug 2934:

   Translating a literal exponent that comes out as a float shouldn't
   produce assigned type any. This test runs the translation for a
   trivial function that triggered the bug then looks in the unlisp
   file (which contains messages from the translator) and checks that
   there aren't any warnings.
*/
/* skip this test (and fail) if Lisp = ECL because stream i/o causes "stack smashing" error
 * see: https://sourceforge.net/p/maxima/bugs/3291/
 */
if build_info()@lisp_name # "ECL" then
(kill (all),
 lisp_name : ssubst ("_", " ", build_info()@lisp_name),
 basename: sconcat (maxima_tempdir, "/tmp-rtest_translator-2934-", lisp_name),
 maxima_filename : sconcat (basename, ".mac"),
 lisp_filename : sconcat (basename, ".LISP"),
 maxima_output : openw (maxima_filename),
 maxima_content : "f () := block([y], mode_declare(y,float), y: 3^0.33, y)$",
 printf (maxima_output, maxima_content),
 close (maxima_output),
 translate_file (maxima_filename, lisp_filename),
 kill (allbut(basename)),
 /* Any warning messages end up at .UNLISP */
 block ([unlisp: openr (sconcat (basename, ".UNLISP")),
         line, acc: []],
   while stringp (line: readline(unlisp)) do
     if is ("warning" = split(line, ":")[1]) then push(line, acc),
   acc));
[]$

/* makelist translated incorrectly
 * SF bug #3083: "Error on compiling a working maxima function"
 */

(kill(all),
 f1(n) := makelist (1, n),
 f2(n) := makelist (i^2, i, n),
 f3(l) := makelist (i^3, i, l),
 f4(n) := makelist (i^4, i, 1, n),
 f5(m, n) := makelist (i^5, i, 1, n, m),
 translate(f1, f2, f3, f4, f5),
 0);
0;

f1(5);
[1,1,1,1,1];

f2(5);
[1, 4, 9, 16, 25];

f3([1,2,3]);
[1, 8, 27];

f4(4);
[1, 16, 81, 256];

f5(2, 10);
[1, 243, 3125, 16807, 59049];

/* original function from bug report */

(ordersort(lis,vars,oper):=block([negsumdispflag:false,liss:lis,varlist:vars,temp], /*Does lexicographical sort */
 for i:1 thru length(varlist) do (
     for j:1 thru i do (
         liss:sort(liss,lambda([x,y],apply("and",map(oper,makelist(part(x,2)[k],k,1,i)
                             ,makelist(part(y,2)[k],k,1,i)))))
     )),liss),
 translate (ordersort)); /* 'translate' doesn't trigger an error, so check return value */
[ordersort];
 
[member ('transfun, properties(ordersort)),
 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],">=")];
[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]]]];

/* 'define' translated incorrectly, reported to mailing list circa 2017-01-24 */

(kill(foo, bar, baz, quux, mumble, blurf, umm, f, x, y),
 foo(y) := define(bar(x), x + y),
 baz(f, y) := define(funmake(f, [x]), x + y),
 quux() := (mumble(x) := 1 + x),
 [foo(10), baz(blurf, 20), quux()]);
/* note that results match because rhs of ":=" isn't simplified */
[bar(x) := 10 + x, blurf(x) := 20 + x, mumble(x) := 1 + x];

[bar(5), blurf(5), mumble(5)];
[15, 25, 6];

(kill(bar, blurf, mumble),
 translate(foo, baz, quux),
 [foo(11), baz(umm, 21), quux()]);
/* note that results match because rhs of ":=" isn't simplified */
[bar(x) := 11 + x, umm(x) := 21 + x, mumble(x) := 1 + x];

makelist (is (x # false), x, map (?fboundp, [foo, baz, quux])); /* test for generalized Boolean value */
[true, true, true];

[bar(5), umm(5), mumble(5)];
[16, 26, 6];

/* mailing list 2017-03-04: "An example that is broken by compile()"
 * translated code tickles a bug elsewhere (bug not in translator)
 */

(kill(fun, trigfunc, t1),
 fun():=block([trigfunc],
        trigfunc:lambda([cur],cur>t1),
        apply('trigfunc,[1])),
 0);
0;

/* I (Robert Dodier) believe this result should be trigfunc(1),
 * but, in any event, interpreted and compiled code should agree.
 * But if MAPPLY1 is ever changed, we can adjust these results.
 */
fun();
1 > t1;

(compile(fun), fun());
1 > t1;

(kill(fun, trigfunc, t1),
 fun():=block([trigfunc],
        trigfunc:lambda([cur],cur>t1),
        apply(trigfunc,[1])),
 0);
0;

fun();
1 > t1;

(compile(fun), fun());
1 > t1;

/* Verify that we catch malformed lambda expressions during translation.
 * More checks need to be added to the translator and more tests need to
 * be added here.
 */

/* no parameter list */
(kill (f),
 f () := lambda (),
 translate (f))$
[];

/* empty body */
(kill (f),
 f () := lambda ([x]),
 translate (f))$
[];

/* non-symbol in parameter list */
(kill (f),
 f () := lambda ([42], 'foo),
 translate (f))$
[];

/* misplaced "rest" parameter */
(kill (f),
 f () := lambda ([[l], x], 'foo),
 translate (f))$
[];

/* invalid "rest" parameter */
(kill (f),
 f () := lambda ([[l1, l2]], 'foo),
 translate (f))$
[];

/* attempting to bind a constant;
 * now OK, after commit 0517895
 */
block ([c, f],
  local (c, f),
  declare (c, constant),
  f () := lambda ([c], c),
  translate (f))$
[f];

/* Verify that parameter/variable lists cannot contain duplicate variables.
 *
 * We only test a couple of cases here.  Many more tests for non-translated
 * code are in rtest2.  Do we want to test them all here as well?
 */

(kill(f),
 f () := lambda ([x, [x]], x),
 translate (f))$
[];

(kill(f),
 f () := block ([x, x:'foo], x),
 translate (f))$
[];

/* ensure that a null OPERATORS property doesn't interfere with
 * translation of local variable used as a function name.
 * This is the bug that caused failures in rtest_fractals when executed after run_testsuite.
 */

(kill(aa, foobarbaz, mumbleblurf, hhh),
 matchdeclare (aa, all),
 tellsimp (mumbleblurf(aa), 1 - aa),
 kill (mumbleblurf), /* as of 2018-01-28, this leaves (OPERATORS NIL) in property list */
 hhh(mumbleblurf, u) := mumbleblurf(u),
 foobarbaz(x) := 100 + x,
 translate (hhh),
 hhh (foobarbaz, 11));
111;

/* SF bug report #3402: "Unbinding defined variable generates error in compiled functions" */

define_variable (zorble, 0, fixnum);
0;

(kill(f), f() := block ([zorble], 42), f());
42;

translate(f);
[f];

f();
42;

/* bug reported to mailing list 2018-12-03: "error in compiling function with global variable" */

(test_f():= block( [a,b,c,d], niceindicespref:[a,b,c,d], disp("ciao"), return() ),
 0);
0;

(test_f (), niceindicespref);
[a,b,c,d];

(reset (niceindicespref),
 niceindicespref);
[i,j,k,l,m,n];

(translate (test_f),
 test_f (),
 niceindicespref);
[a,b,c,d];

(reset (niceindicespref), 0);
0;

/* additional tests with variables which have ASSIGN property */

(set_error_stuff_permanently () :=
  block (error_syms : '[myerr1, myerr2, myerr3], error_size : 40),
 set_error_stuff_temporarily() :=
   block([error_syms : '[myerror1, myerror2, myerror3], error_size : 55],
         [error_syms, error_size]),
 0);
0;

(reset (error_syms, error_size),
 set_error_stuff_permanently (),
 [error_syms, error_size]);
[[myerr1, myerr2, myerr3], 40];

(reset (error_syms, error_size),
 translate (set_error_stuff_permanently),
 set_error_stuff_permanently (),
 [error_syms, error_size]);
[[myerr1, myerr2, myerr3], 40];

(reset (error_syms, error_size),
 set_error_stuff_temporarily());
[[myerror1, myerror2, myerror3], 55];

[error_syms, error_size];
[[errexp1, errexp2, errexp3], 60];

(translate (set_error_stuff_temporarily),
 set_error_stuff_temporarily());
[[myerror1, myerror2, myerror3], 55];

[error_syms, error_size];
[[errexp1, errexp2, errexp3], 60];

(kill(all), reset(), 0);
0;

/* SF bug #3412: "Bug when translating functions that contain an \"if\" (in my case an implicit if)" */

(f(x):=if cabs(1/(x+1)) < 1 then 1/(x+1) else 1,
 f(x + %i*y));
if 1/sqrt(y^2+(x+1)^2) < 1 then 1/(%i*y+x+1) else 1;

makelist (f(xy[1] + %i*xy[2]), xy, [[0, 0], [0, 1], [1, 1], [1, 0], [0, 2], [2, 2], [2, 0]]);
[1, 1/(%i+1), 1/(%i+2), 1/2, 1/(2*%i+1), 1/(2*%i+3), 1/3]$

(compile (f),
 errcatch (f(x + %i*y)));
[];

'(f(x + %i*y));
f(x + %i*y);

makelist (f(xy[1] + %i*xy[2]), xy, [[0, 0], [0, 1], [1, 1], [1, 0], [0, 2], [2, 2], [2, 0]]);
[1, 1/(%i+1), 1/(%i+2), 1/2, 1/(2*%i+1), 1/(2*%i+3), 1/3]$

(if draw_version = 'draw_version then load (draw),
 draw3d(contour='map,
        proportional_axes=xy,
        nticks=100,
        contour_levels=20,
        explicit('(f(x+%i*y)),x,-2,2,y,-2,2)),
 0);
0;

/* nested if example -- note top-level "if" doesn't have an "else" clause, so the result is sometimes 'false' */

(g(a, b, c) := if a + b > c
                 then (if a > c
                         then (if b > c
                                 then (a + b + c)
                                 elseif b > c/2
                                   then (a - b - c)
                                   else (b - a - c))
                         else (a/2)),
 0);
0;

(aa: [3,9/4,5/4,11/4,1,0,9/4,1/4,5/2,9/4,3,5/2],
 bb: [3/2,3,1/4,3/4,5/2,7/4,5/2,3/4,1/2,3,13/4,7/2],
 cc: [7/2,15/4,5/2,5/4,15/4,1,1/4,7/4,2,11/4,1/4,7/4],
 map (g, aa, bb, cc));
[3/2,9/8,false,3/4,false,0,5,false,-4,9/8,13/2,31/4]$

(translate (g),
 map (g, aa, bb, cc));
[3/2,9/8,false,3/4,false,0,5,false,-4,9/8,13/2,31/4]$

errcatch (g(1, 1, z));
[];

/* SF bug #3556: "5.43.0 translate / compile error"
 * Ensure that "if" within lambda is translated correctly.
 * The fix for #3412 tickled this bug.
 */

(kill (f),
 f(x, m) := map (lambda ([u], if m > 0 then u^m), [x, 2*x, 3*x]),
 0);
0;

is (?fboundp (f) # false);
false;

(kill (y),
 [f(y, 2), f(y, -2)]);
[[y^2, 4*y^2, 9*y^2], [false, false, false]];

(kill (n),
 errcatch (f(10, n)));
/* ensure that conditional expressions get simplified to expunge $FALSE ... sigh. */
''([[if n > 0 then 10^n, if n > 0 then 20^n, if n > 0 then 30^n]]);

translate (f);
[f];

is (?fboundp (f) # false); /* test for generalized Boolean value */
true;

[f(y, 2), f(y, -2)];
[[y^2, 4*y^2, 9*y^2], [false, false, false]];

errcatch (f(10, n));
[];

/* apply2 was translated incorrectly for several years.  applyb2
 * was translated incorrectly for decades.
 */

(defrule (foorule, foo (), 1),
 f () := apply2 ('(foo ()), foorule),
 translate (f),
 f ());
1;

(defrule (barrule, bar (), 2),
 g () := applyb2 ('(bar ()), barrule),
 translate (g),
 g ());
2;

(kill (foorule, f, barrule, g), 0);
0;

/* atan and atan2 calls with float arguments were translated
 * incorrectly for over a decade.  atan always caused a lisp error
 * and atan2 had a range between 0 and 2*%pi that was inconsistent
 * with the interpreted and non-float cases (where the range is
 * between -%pi and %pi).
 */

(foo () := [atan2 (-1.0, -1.0), atan2 (-1.0, 1.0)],
 translate (foo),
 foo ());
[-2.356194490192345, -0.7853981633974483];

(bar () := atan (-1.0),
 translate (bar),
 bar ());
-0.7853981633974483;

(kill (foo, bar), 0);
0;

/* The translation of a signum call with a float argument was
 * inconsistent when compared to the interpreted case and other
 * translated cases.  signum should return an integer or a float
 * when given an integer or a float argument, respectively.
 */

(foo () := [signum (0),  signum (0.0),
            signum (2),  signum (2.0),
            signum (-3), signum (-3.0)],
 translate (foo),
 foo ());
[0, 0.0, 1, 1.0, -1, -1.0];

(kill (foo), 0);
0;

/* The translation of declare was broken for decades.  It worked
 * under Maclisp, but it had never worked under Common Lisp.
 */

(foo () := declare (n, integer, [x, y], noninteger),
 translate (foo),
 foo (),
 [?kindp (n, integer),
  ?kindp (n, noninteger),
  ?kindp (x, integer),
  ?kindp (x, noninteger),
  ?kindp (y, integer),
  ?kindp (y, noninteger)]);
[true, false, false, true, false, true];

(kill (foo, n, x, y), 0);
0;

/* If a variable was declared to be of mode rational, then a lisp
 * error could occur during translation when attempting to convert
 * it to a float.
 */

(foo (x) := (mode_declare (x, rational), float (x)),
 bar (y) := (mode_declare (y, rational), 1.0 + y),
 translate (foo, bar),
 [foo (1/4), bar (1/2)]);
[0.25, 1.5];

(kill (foo, bar, x, y), 0);
0;

/* The translation of an atan2 call with one float and one rational
 * argument was broken because the rational was not converted to a
 * float before calling ATAN.
 */

(foo () :=
   [atan2 (0.0, -1/2),
    atan2 (-1/2, 0.0),
    atan2 (0.0, -1),
    atan2 (1, 0.0)],
 bar (y, x) := (mode_declare (x, float, y, rational), atan2 (y, x)),
 l1 : [foo (), bar (1/3, 0.0)],
 translate (foo, bar),
 l2 : [foo (), bar (1/3, 0.0)],
 is (l1 = l2));
true;

(kill (foo, bar, x, y, l1, l2), 0);
0;

/* When attempting to apply float contagion to the arguments, some
 * translations of max and min with mixed float and rational arguments
 * were broken because the rationals were not converted to floats before
 * calling MAX or MIN (like atan2 above).  Also, due to implementation-
 * dependent behavior in the underlying lisp regarding what to return
 * from MAX and MIN, the wrong mode could be used during translation and
 * some of the translations were possibly inconsistent with interpreted
 * cases.
 */

(foo (x) :=
   (mode_declare (x, rational),
    [max (),         min (),
     max (1),        min (1),
     max (1.0),      min (1.0),
     max (9/10),     min (9/10),
     max (x)   ,     min (x),
     max (0.0, 1),   min (0.0, 1),
     max (0, 1),     min (0, 1),
     max (1.0, 1),   min (1.0, 1),
     max (1, 1.0),   min (1, 1.0),
     max (2.0, 3.0), min (2.0, 3.0),
     max (-1, 1/2),  min (-1, 1/2),
     max (3/4, 1/2), min (3/4, 1/2),
     max (0.0, 1/2), min (0.0, 1/2),
     max (0, x),     min (0, x),
     max (-1.0, x),  min (-1.0, x),
     max (5/6, x),   min (5/6, x),
     max (x, 1),     min (x, 1)]),
 l1 : foo (2/3),
 translate (foo),
 l2 : foo (2/3),
 is (l1 = l2));
true;

(kill (foo, x, l1, l2), 0);
0;

/* log and sqrt did not honor tr_float_can_branch_complex */

(foo (x) :=
   (mode_declare (x, float),
    [log  (-1.0), log  (x),
     sqrt (-1.0), sqrt (x)]),
 /* l1 is a list of Maxima complex numbers */
 l1 : foo (-2.0),
 some (lambda ([x], freeof (%i, x)), l1));
false;

block ([tr_float_can_branch_complex : false],
  translate (foo),
  /* l2 is a list of lisp complex numbers because we told the
   * translator to assume the return values of log and sqrt
   * would not be complex, and it correctly returned the complex
   * numbers returned by LOG and SQRT directly.
   */
  l2 : foo (-2.0),
  [every (?complexp, l2),
   every ("#", l1, l2)]);
[true,
 true];

block ([tr_float_can_branch_complex : true],
  translate (foo),
  /* l3 is a list of Maxima complex numbers because we told the
   * translator to assume the return values of log and sqrt
   * could be complex, and it converted the lisp complex numbers
   * returned by LOG and SQRT to Maxima complex numbers.
   */
  l3 : foo (-2.0),
  every ("=", l1, l3));
true;

(kill (foo, x, l1, l2, l3), 0);
0;

/* The translations for evaluating = and # expressions to boolean
 * values with one float argument and a different numerical argument
 * (e.g. a fixnum) gave bogus results because the translator was
 * incorrectly applying float contagion to the arguments.
 */

(foo (s, w, x, y, z) :=
  (mode_declare (w, number, x, fixnum, y, flonum),
   [/* These translate to EQL comparisons */
    is (1 = 1),                 is (1 # 1),
    is (1 = 1.0),               is (1 # 1.0),
    is (1 = float (1)),         is (1 # float (1)),
    is (1.0 = float (1)),       is (1.0 # float (1)),
    is (w = 2),                 is (w # 2),
    is (w = 2.0),               is (w # 2.0),
    is (x = 3),                 is (x # 3),
    is (x = 3.0),               is (x # 3.0),
    is (x = float (3)),         is (x # float (3)),
    is (x = float (x)),         is (x # float (x)),
    is (y = 4),                 is (y # 4),
    is (y = 4.0),               is (y # 4.0),
    is (y = float (4)),         is (y # float (4)),
    is (y = float (y)),         is (y # float (y)),
    /* These translate to LIKE comparisons */
    is (z = 5),                 is (z # 5),
    is (z = 5.0),               is (z # 5.0),
    is (z = float (5)),         is (z # float (5)),
    is (z = float (z)),         is (z # float (z)),
    is (1/2 = 1/2),             is (1/2 # 1/2),
    is (1/2 = rat (1/2)),       is (1/2 # rat (1/2)),
    is (rat (1/2) = rat (1/2)), is (rat (1/2) # rat (1/2)),
    is (1/2 = 0.5),             is (1/2 # 0.5),
    is (1/2 = float (1/2)),     is (1/2 # float (1/2)),
    is (%i = %i),               is (%i # %i),
    is (1 + %i = 1 + %i),       is (1 + %i # 1 + %i),
    is (s = s),                 is (s # s),
    is (s = 'bar),              is (s # 'bar),
    is (s = 1),                 is (s # 1),
    is (s = 1.0),               is (s # 1.0),
    is (s = 1/2),               is (s # 1/2),
    is ('f (0) = 'f (0)),       is ('f (0) # 'f (0)),
    is ('g (s) = 'g (s)),       is ('g (s) # 'g (s)),
    is ('h (w) = 'h (w)),       is ('h (w) # 'h (w)),
    is ('i (x) = 'i (x)),       is ('i (x) # 'i (x)),
    is ('j (y) = 'j (y)),       is ('j (y) # 'j (y)),
    is ('k (z) = 'k (z)),       is ('k (z) # 'k (z))]),
 l1 : foo ('bar, 2, 3, 4.0, 5),
 translate (foo),
 l2 : foo ('bar, 2, 3, 4.0, 5),
 [every (lambda ([x], ?typep (x, ?boolean)), l2),
  is (l1 = l2)]);
[true,
 true];

(kill (foo, w, x, y, l1, l2), 0);
0;

/* Bug #3048: notequal is not translated properly
 *
 * notequal expressions were only generically translated like user
 * function calls and the use of notequal in translated code caused
 * a runtime warning about it being totally undefined.  Also the
 * evaluation of notequal expressions to boolean values (via is, if,
 * etc.) were translated like the evaluation of an unknown predicate.
 */

(assume (equal (a, b), notequal (c, d)),
 foo () :=
  [is (equal (1, 1)),
   is (notequal (1, 1)),
   is (equal (1, 1.0)),
   is (notequal (1, 1.0)),
   is (equal (1, 1.0b0)),
   is (notequal (1, 1.0b0)),
   is (equal (1/2, 0.5)),
   is (notequal (1/2, 0.5)),
   is (equal (1/2, 0.5b0)),
   is (notequal (1/2, 0.5b0)),
   is (equal (1, 2)),
   is (notequal (1, 2)),
   is (equal ('ind, 'ind)),
   is (notequal ('ind, 'ind)),
   is (equal ('und, 'und)),
   is (notequal ('und, 'und)),
   is (equal ('a, 'b)),
   is (notequal ('a, 'b)),
   is (equal ('c, 'd)),
   is (notequal ('c, 'd)),
   is (equal (x^2 - 1, (x + 1) * (x - 1))),
   is (notequal (x^2 - 1, (x + 1) * (x - 1)))],
 l1 : foo (),
 translate (foo),
 l2 : foo (),
 [every (lambda ([x], ?typep (x, ?boolean)), l2),
  is (l1 = l2)]);
[true,
 true];

(kill (foo, l1, l2),
 forget (equal (a, b), notequal (c, d)),
 0);
0;

/* The translation of a call to random with a float argument could
 * cause the generation of bogus code because this always had the
 * mode of fixnum.
 */

(foo (w, x, y, z) :=
  (mode_declare (w, fixnum, x, float),
   [[random (10),
     random (w),
     random (y)],
    [random (1.0),
     random (x),
     random (z),
     random (x) / 2,
     random (z) / 2,
     1 / (1 + random (x))],
    [random (10) / 2,
     random (w) / 3,
     random (y) / 4,
     1 / (1 + random (w)),
     1 / (1 + random (y))]]),
 translate (foo),
 l : foo (50, 5.0, 100, 10.0),
 [every (integerp, first (l)),
  every (floatnump, second (l)),
  every (ratnump, third (l))]);
[true,
 true,
 true];

(kill (foo, w, x, l), 0);
0;
