/*************** -*- Mode: MACSYMA; Package: MAXIMA -*-  ******************/
/***************************************************************************
***                                                                    *****
***     Copyright (c) 1984 by William Schelter,University of Texas     *****
***     All rights reserved                                            *****
***************************************************************************/

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

integrate(x^(5/4)/(x+1)^(5/2),x,0,inf);
beta(9/4,1/4);
gradef(q(x),sin(x^2));
q(x);
diff(log(q(r(x))),x);
'diff(r(x),x,1)*sin(r(x)^2)/q(r(x));
integrate(%,x);
log(q(r(x)));

?nformat(?complex(1,2));
2*%i + 1;
?nformat(?/(1,2)); /* ?/(1,2) equivalent to (/ 1 2) in Lisp */
1/2$

/* example for now-disable interval struct in src/nforma.lisp
?typep(interval(1,2),?ri);
true$
 */
is(part(?complex(1,2),0)="+");
true$

/* bug reported to mailing list 2013-05-22 */

block ([a, L],
  a : make_array (fixnum, 3),
  L : buildq ([a], lambda ([x], a[x])),
  print (L, L(0))); /* print(L) --> calls NFORMAT and therefore tickles bug */
0;

/* expressions like f(x)(y) */

(kill (f, x, y), f(x)(y));
f(x)(y);

(f(x)(y), [op (%%), args (%%)]);
[f(x), [y]];

(f(x)(y), [op (op (%%)), args (op (%%))]);
[f, [x]];

apply (f(x), [y]);
f(x)(y);

(kill (z), f(x)(y)(z));
f(x)(y)(z);

(f(x)(y)(z), [op (%%), args (%%), op (op (%%)), args (op (%%)), op (op (op (%%))), args (op (op (%%)))]);
[f(x)(y), [z], f(x), [y], f, [x]];

ev (f(x)(y), f(u) := buildq ([u], lambda ([v], v*u)));
x*y;

apply (f(x)(y), [z]);
f(x)(y)(z);

map (f(x), [1, 2, 3]);
[f(x)(1), f(x)(2), f(x)(3)];

(f(u) := subst (u, 'u, lambda ([v], v^u)),
 [f(x), f(x)(y)]);
[lambda ([v], v^x), y^x];

(kill (f),
 matchdeclare (xx, integerp),
 tellsimp (f(xx), subst ('xx = xx, lambda ([a], a - xx))),
 [f(1), f(1)(y)]);
[lambda ([a], a - 1), y - 1];

(remrule (f, all), 0);
0;

(matchdeclare ([xx, yy], integerp),
 tellsimp (f(xx)(yy), yy*xx),
 [f(2), f(2)(3)]);
[f(2), 6];

kill (rules);
done;

/* verify that subscripted functions are formatted without superfluous parentheses
 * see SF bug #2998: "extra () in display2d:false output"
 */

(kill (foo, x, y),
 string (foo[x](y)));
"foo[x](y)";

[string (li[2](x)), string (psi[3](y))];
["li[2](x)", "psi[3](y)"];

/* further tests for #2998 combining subscripted functions with various user-defined operators */

block ([opsies : ["infixie", "prefixie", "postfixie", "naryie", "matchfixie", "nofixie"]],
  apply (kill, opsies),
  map (lambda ([f, a], apply (f, [a])), [infix, prefix, postfix, nary, lambda ([a], matchfix (a, a)), nofix], opsies),
  kill (foo, bar, baz, a, b, c, x, y, z),
  0);
0;

foo[x, y](a) infixie bar[z](b, c);
(foo[x, y](a)) infixie (bar[z](b, c));

string ((foo[x, y](a)) infixie (bar[z](b, c)));
"foo[x,y](a) infixie bar[z](b,c)";

bar[a, a](x, x) naryie baz[a](x, y) naryie prefixie foo[a, b](x, y);
(bar[a, a](x, x)) naryie (baz[a](x, y)) naryie (prefixie (foo[a, b](x, y)));

string ((bar[a, a](x, x)) naryie (baz[a](x, y)) naryie (prefixie (foo[a, b](x, y))));
"bar[a,a](x,x) naryie baz[a](x,y) naryie prefixie foo[a,b](x,y)";

matchfixie foo[1](z) matchfixie;
matchfixie (foo[1](z)) matchfixie;

string (matchfixie (foo[1](z)) matchfixie);
"matchfixiefoo[1](z)matchfixie";

/* ... and with built-in operators */

foo[x, y](a)^bar[z](b, c);
(foo[x, y](a))^(bar[z](b, c));

string ((foo[x, y](a))^(bar[z](b, c)));
"foo[x,y](a)^bar[z](b,c)";

bar[a, a](x, x) and baz[a](x, y) and not foo[a, b](x, y);
(bar[a, a](x, x)) and (baz[a](x, y)) and (not (foo[a, b](x, y)));

string ((bar[a, a](x, x)) and (baz[a](x, y)) and (not (foo[a, b](x, y))));
"bar[a,a](x,x) and baz[a](x,y) and not foo[a,b](x,y)";

[ foo[1](z) ];
[ (foo[1](z)) ];

string ([ (foo[1](z)) ]);
"[foo[1](z)]";

/* mailing list 2015-10-05: "Wrong result from integrate?" */

(kill(t, R), integrate(sqrt(sin(t)^2*R^2+(1-cos(t))^2*R^2),t,0,2*%pi));
8*R;

/* SF bug #2845: "Avoid initialization-time compile in commac.lisp"
 * Ensure that functions to strip trailing zero digits continue to work.
 */

string (25.0);
"25.0";

string(1/16.0);
"0.0625";

(string(2e7), %% = "2.0e+7" or %% = "2.0E+7" or %% = "2.0e7" or %% = "2.0E7" or %%);
true;

(string(2e-7), %% = "2.0e-7" or %% = "2.0E-7" or %%);
true;

(string(12345000000.0), %% = "1.2345e+10" or %% = "1.2345E+10" or %% = "1.2345e10" or %% = "1.2345E10" or %%);
true;

(string(1/1024.0), %% = "9.765625e-4" or %% = "9.765625E-4" or %%);
true;

/* SF bug #4107: "least_positive_float doesn't print/read correctly in float/bfloat" */

(reset (fpprintprec), 0);
0;

is (parse_string (string (most_positive_float)) = most_positive_float);
true;

is (parse_string (string (least_positive_float)) = least_positive_float);
true;

is (parse_string (string (least_positive_normalized_float)) = least_positive_normalized_float);
true;

is (parse_string (string (most_negative_float)) = most_negative_float);
true;

is (parse_string (string (least_negative_float)) = least_negative_float);
true;

is (parse_string (string (least_negative_normalized_float)) = least_negative_normalized_float);
true;

is (parse_string (string (float_eps ())) = float_eps ());
true;

/* bug reported to mailing list 2023-09-25: "Casting SPELs" */

(kill (all),
SPEL([rest])::= buildq(
  [rest],
  buildq(splice(rest)) ),
game_action(command,subj,obj,place,[rest])::= SPEL(
  [command,subj,obj,place,rest],
  block(
     infix(command),
     command(subject,object):= block(
        if location = place
           and subject = subj
           and object = obj
           and have(subj) then apply(sconcat,rest)
        else sconcat("you cannot ",command," like that. ") ))),
game_action("weld",chain,bucket,attic,
  if have(bucket)
  and not chain_welded then (
     chain_welded: true,
     "the chain is now securely welded to the bucket. " )
  else "you do not have a bucket. "),
0);
0;

chain weld bucket;
"you cannot weld like that. ";

subst (f = "foo", f(x));
foo(x);

/* tests for iterating over hash tables
 * verify both value hash tables ("fast arrays" or created by make_array)
 * and named hash tables ("undeclared arrays").
 */

kill (all);
done;

/* value hash tables: "fast arrays" */

use_fast_arrays: true;
true;

/* one key */

(aa1["baz"]: 333, aa1["bar"]: 222, aa1["quux"]: 444, aa1["foo"]: 111, 0);
0;

?hash\-table\-p (aa1);
true;

a: 100;
100;

block ([L: []], for a in aa1 do push ([a[2], a[1]], L), sort (L));
[[111, ["foo"]], [222, ["bar"]], [333, ["baz"]], [444, ["quux"]]];

a;
100;

block ([L: []], for b in aa1 do push ([b[2], b[1]], L), sort (L));
[[111, ["foo"]], [222, ["bar"]], [333, ["baz"]], [444, ["quux"]]];

b;
b;

block ([L: []], for [a, b] in aa1 do push ([b, a], L), sort (L));
[[111, ["foo"]], [222, ["bar"]], [333, ["baz"]], [444, ["quux"]]];

[a, b];
[100, b];

block ([L: []], for [[a], b] in aa1 do push ([b, a], L), sort (L));
[[111, "foo"], [222, "bar"], [333, "baz"], [444, "quux"]];

[a, b];
[100, b];

/* two keys */

(aa2[xx, 99]: %pi, aa2[cc, 1099]: %phi, aa2[jj, 543]: %e, 0);
0;

?hash\-table\-p (aa2);
true;

block ([L: []], for a in aa2 do push ([a[2], a[1]], L), sort (L));
[[%e, [jj, 543]], [%phi, [cc, 1099]], [%pi, [xx, 99]]];

a;
100;

block ([L: []], for b in aa2 do push ([b[2], b[1]], L), sort (L));
[[%e, [jj, 543]], [%phi, [cc, 1099]], [%pi, [xx, 99]]];

b;
b;

block ([L: []], for [a, b] in aa2 do push ([b, a], L), sort (L));
[[%e, [jj, 543]], [%phi, [cc, 1099]], [%pi, [xx, 99]]];

[a, b];
[100, b];

(a2: 300, b: -2);
-2;

block ([L: []], for [[a1, a2], b] in aa2 do push ([b, a2, a1], L), sort (L));
[[%e, 543, jj], [%phi, 1099, cc], [%pi, 99, xx]];

[a1, a2, b];
[a1, 300, -2];

/* three keys */

(aa3["mno", "pqr", 1 - 2*u]: bessel_j (2, 1 - sqrt(x)),
 aa3["fgh", 3*u*v, giraffe]: rhino*elephant,
 aa3["glorble", 7*x, emu]: 6/cricket,
 0);
0;

?hash\-table\-p (aa3);
true;

[b, a];
[-2, 100];

block ([L: []], for b in aa3 do push ([b[1], b[2]], L), sort (L));
[[["fgh", 3*u*v, giraffe], rhino*elephant],
 [["glorble", 7*x, emu], 6/cricket],
 [["mno", "pqr", 1 - 2*u], bessel_j (2, 1 - sqrt(x))]];

b;
-2;

block ([L: []], for [b, a] in aa3 do push ([b, a], L), sort (L));
[[["fgh", 3*u*v, giraffe], rhino*elephant],
 [["glorble", 7*x, emu], 6/cricket],
 [["mno", "pqr", 1 - 2*u], bessel_j (2, 1 - sqrt(x))]];

[b, a];
[-2, 100];

block ([L: []], for [[a1, a2, b], a] in aa3 do push ([a1, a2, b, a], L), sort (L));
[["fgh", 3*u*v, giraffe, rhino*elephant],
 ["glorble", 7*x, emu, 6/cricket],
 ["mno", "pqr", 1 - 2*u, bessel_j (2, 1 - sqrt(x))]];

[a1, a2, b, a];
[a1, 300, -2, 100];

arrays;
[];

(reset (use_fast_arrays), kill (all));
done;

/* value hash tables: created by make_array */

/* one key */

(hh1: make_array (hashed, 1), 0);
0;

?hash\-table\-p (hh1);
true;

(hh1[1 + x]: sin(z), hh1[3 - y]: cos(w), hh1[1/(1 + z)]: tan(x), 0);
0;

(f: 199, g: 200);
200;

block ([L: []], for g in hh1 do push ([g[2], g[1]], L), sort (L));
[[cos(w), [3 - y]], [tan(x), [1/(1 + z)]], [sin(z), [1 + x]]];

g;
200;

block ([L: []], for [f, g] in hh1 do push ([g, f], L), sort (L));
[[cos(w), [3 - y]], [tan(x), [1/(1 + z)]], [sin(z), [1 + x]]];

[f, g];
[199, 200];

block ([L: []], for [[f], g] in hh1 do push ([g, f], L), sort (L));
[[cos(w), 3 - y], [tan(x), 1/(1 + z)], [sin(z), 1 + x]];

[f, g];
[199, 200];

/* two keys */

(hh2: make_array (hashed, 1, 1), 0);
0;

?hash\-table\-p (hh2);
true;

(hh2[678, "blurf"]: 876 - mumble,
 hh2[987, "sdf"]: 777*zxy,
 hh2[456, cos(w)]: sin(u) - cos(v),
 0);
0;

block ([L: []], for y in hh2 do push ([y[1], y[2]], L), sort (L));
[[[456, cos(w)], sin(u) - cos(v)],
 [[678, "blurf"], 876 - mumble],
 [[987, "sdf"], 777*zxy]];

y;
y;

block ([L: []], for [x, y] in hh2 do push ([x, y], L), sort (L));
[[[456, cos(w)], sin(u) - cos(v)],
 [[678, "blurf"], 876 - mumble],
 [[987, "sdf"], 777*zxy]];

[x, y];
[x, y];

block ([L: []], for [[x1, x2], y] in hh2 do push ([x1, x2, y], L), sort (L));
[[456, cos(w), sin(u) - cos(v)],
 [678, "blurf", 876 - mumble],
 [987, "sdf", 777*zxy]];

[x1, x2, y];
[x1, x2, y];

/* three keys */

(hh3: make_array (hashed, 1, 1, 1), 0);
0;

?hash\-table\-p (hh3);
true;

(hh3[hgf, fds, jhg]: cos(trwq),
 hh3[asdfg, 1 - rewq, 2*treww]: sin(poiur) - cos(kjghds),
 hh3[ewq, 2 - jdssaaq, 3*cxmmz]: sqrt(ytre),
 0);
0;

block ([L: []], for q in hh3 do push ([q[1], q[2]], L), sort (L));
[[[asdfg, 1 - rewq, 2*treww], sin(poiur) - cos(kjghds)],
 [[ewq, 2 - jdssaaq, 3*cxmmz], sqrt(ytre)],
 [[hgf, fds, jhg], cos(trwq)]];

q;
q;

block ([L: []], for [p, q] in hh3 do push ([p, q], L), sort (L));
[[[asdfg, 1 - rewq, 2*treww], sin(poiur) - cos(kjghds)],
 [[ewq, 2 - jdssaaq, 3*cxmmz], sqrt(ytre)],
 [[hgf, fds, jhg], cos(trwq)]];

[p, q];
[p, q];

block ([L: []], for [[p1, p2, p3], q] in hh3 do push ([p1, p2, p3, q], L), sort (L));
[[asdfg, 1 - rewq, 2*treww, sin(poiur) - cos(kjghds)],
 [ewq, 2 - jdssaaq, 3*cxmmz, sqrt(ytre)],
 [hgf, fds, jhg, cos(trwq)]];

[p1, p2, p3, q];
[p1, p2, p3, q];

arrays;
[];

kill (all);
done;

/* named hash tables: "undeclared arrays" */

/* one key */

(bb1["mumble"]: 123, bb1["blarf"]: 234, bb1["blurf"]: 999, bb1["blarg"]: 345, 0);
0;

?hash\-table\-p (bb1);
false;

arrays;
[bb1];

block ([L: []], for v in bb1 do push ([v[2], v[1]], L), sort (L));
[[123, ["mumble"]], [234, ["blarf"]], [345, ["blarg"]], [999, ["blurf"]]];

v;
v;

block ([L: []], for [u, v] in bb1 do push ([v, u], L), sort (L));
[[123, ["mumble"]], [234, ["blarf"]], [345, ["blarg"]], [999, ["blurf"]]];

[u, v];
[u, v];

block ([L: []], for [[u], v] in bb1 do push ([v, u], L), sort (L));
[[123, "mumble"], [234, "blarf"], [345, "blarg"], [999, "blurf"]];

[u, v];
[u, v];

/* two keys */

(bb2["pqr", 1 + %pi]: sin(k*%pi), bb2["zxy", 2*%pi]: cos(m*%pi), bb2["hgfedc", 3 - blurf]: tan(n*%pi), 0);
0;

arrays;
[bb1, bb2];

w: 321;
321;

block ([L: []], for w in bb2 do push ([w[1], w[2]], L), sort (L));
[[["hgfedc", 3 - blurf], tan(n*%pi)], [["pqr", 1 + %pi], sin(k*%pi)], [["zxy", 2*%pi], cos(m*%pi)]];

w;
321;

block ([L: []], for [v, w] in bb2 do push ([v, w], L), sort (L));
[[["hgfedc", 3 - blurf], tan(n*%pi)], [["pqr", 1 + %pi], sin(k*%pi)], [["zxy", 2*%pi], cos(m*%pi)]];

[v, w];
[v, 321];

v2: 432;
432;

block ([L: []], for [[v1, v2], w] in bb2 do push ([v1, v2, w], L), sort (L));
[["hgfedc", 3 - blurf, tan(n*%pi)], ["pqr", 1 + %pi, sin(k*%pi)], ["zxy", 2*%pi, cos(m*%pi)]];

[v1,v2, w];
[v1, 432, 321];

/* three keys */

(bb3[zxy, "blah", cos(a) + cos(b)]: tan(a + b),
 bb3[hjk, "mumble", cos(y) - x]: cot(a - b),
 bb3[uvw, "qwerty", foo(z) + q]: sec(2*b - a),
 0);
0;

arrays;
[bb1, bb2, bb3];

block ([L: []], for v in bb3 do push ([v[1], v[2]], L), sort (L));
[[[hjk, "mumble", cos(y) - x], cot(a - b)],
 [[uvw, "qwerty", foo(z) + q], sec(2*b - a)],
 [[zxy, "blah", cos(a) + cos(b)], tan(a + b)]];

v;
v;

block ([L: []], for [w, v] in bb3 do push ([w, v], L), sort (L));
[[[hjk, "mumble", cos(y) - x], cot(a - b)],
 [[uvw, "qwerty", foo(z) + q], sec(2*b - a)],
 [[zxy, "blah", cos(a) + cos(b)], tan(a + b)]];

[w, v];
[321, v];

block ([L: []], for [[v1, v2, w], v] in bb3 do push ([v1, v2, w, v], L), sort (L));
[[hjk, "mumble", cos(y) - x, cot(a - b)],
 [uvw, "qwerty", foo(z) + q, sec(2*b - a)],
 [zxy, "blah", cos(a) + cos(b), tan(a + b)]];


[v1, v2, w, v];
[v1, 432, 321, v];

/* additional tests for MUNBIND */

kill (all);
done;

(a: "foo", b: "bar", c: "baz", 0);
0;

(blurf (a, b, c, d, e, f) := (a + b + c)*(d + e + f),
 blurf (1, 2, 3, 4, 5, 6));
90;

[a, b, c, d, e, f];
["foo", "bar", "baz", d, e, f];

(x1: 123,
 mumble (a, b, [L]) := (a + b) * lsum (x1, x1, L),
 mumble (7, 8, 9, 10, 11));
450;

[a, b, L, x1];
["foo", "bar", L, 123];

(harrumph (b, 'c, d) := b*c*d,
 harrumph (111, x1, %pi));
111*x1*%pi;

[b, c, d];
["bar", "baz", d];

(blarg[x, b] := x^b,
 blarg[1 - u, 1 - k]);
(1 - u)^(1 - k);

[b, x];
["bar", x];

(y: 999,
 hurfgh[c](x, y) := (x + y)*c,
 hurfgh[n](4, 2*w));
n*(2*w + 4);

[c, x, y];
["baz", x, 999];

block ([L: []], for b: 10 thru 20 do push (b, L), L);
[20, 19, 18, 17, 16, 15, 14, 13, 12, 11, 10];

[L, b];
[L, "bar"];

sum (b^2, b, 3, 5);
50;

b;
"bar";

product (c/2, c, 6, 8);
42;

c;
"baz";

'sum (b^2, b, 3, 5);
'sum (b^2, b, 3, 5);

b;
"bar";

'product (c/2, c, 6, 8);
'product (c/2, c, 6, 8);

c;
"baz";

block ([d, c, b, a: 111], b: 2, c: 3, a*b*c*d);
666*d;

[a, b, c, d];
["foo", "bar", "baz", d];

lambda ([c, f, g, b], (c + f)*(g + b))(x1, 1 - u, %e, %pi);
(124 - u)*(%e + %pi);

[b, c, f, g];
["bar", "baz", f, g];

lambda ([a,'b], a^b)(11, x1);
11^x1;

[a, b, x1];
["foo", "bar", 123];

lambda ([a,b,[c]], lsum(c1^2, c1, c)^(a^b))(%pi, %e, x1, y, u);
(u^2  + 1013130)^(%pi^%e);

[a, b, c, c1];
["foo", "bar", "baz", c1];

/* ensure that unbound loop variable which has an ASSIGN property
 * is not assigned the value of MUNBOUND (a symbol) in the loop clean-up.
 */

(kill (foo),
 define_variable (foo, 1111, integer),
 remvalue (foo),
 ?boundp (foo));
false;

errcatch (foo: 'abcd); /* expected to provoke assignment error */
[];

block ([L: []], for [foo] in [[11], [22], [33]] do push (foo, L), L);
[33, 22, 11];

?boundp (foo);
false;

