/* Tests for Maxima's trace and timer */

(kill (all),
 0);
0;

/* Bug #3247: Maxima's trace and timer handle rules incorrectly */

(kill (r),
 defrule (r, foo, bar),
 0)$
0;

(trace (r),
 trace_options (r, noprint),
 0)$
0;

/* This used to return foo */
apply1 (foo, r);
'bar;

untrace (r)$
[r];

timer (r)$
[r];

/* This also used to return foo */
apply1 (foo, r);
'bar;

(untimer (r),
 kill (r),
 0);
0;

/* Bug #2803: trace/timer do not work for functions with quoted arguments
 *
 * Here we test some traced and timed functions that have different
 * combinations of quoted and rest args.  The timer tests are actually
 * redundant since trace and timer didn't require separate fixes.
 */

/* Watch out for extra evaluations */
([a, b, c, d] : [u, v, w, x],
 [u, v, w, x] : [1, 2, 3, 4],
 0)$
0;

(f1 ('x) := x,
 0);
0;

(trace (f1),
 trace_options (f1, noprint),
 0);
0;

f1 (a);
'a;

f1 (error ());
'(error ());

(untrace (f1),
 0);
0;

(timer (f1),
 0);
0;

f1 (a);
'a;

f1 (error ());
'(error ());

(kill (f1),
 0);
0;

(f2 (['x]) := x,
 0);
0;

(trace (f2),
 trace_options (f2, noprint),
 0);
0;

f2 ();
[];

f2 (a, b, c, d);
['a, 'b, 'c, 'd];

f2 (error (), error (), error (), error ());
['(error ()), '(error ()), '(error ()), '(error ())];

(untrace (f2),
 0);
0;

(timer (f2),
 0);
0;

f2 ();
[];

f2 (a, b, c, d);
['a, 'b, 'c, 'd];

f2 (error (), error (), error (), error ());
['(error ()), '(error ()), '(error ()), '(error ())];

(kill (f2),
 0);
0;

(f3 ('x, y, z) := [x, y, z],
 0);
0;

(trace (f3),
 trace_options (f3, noprint),
 0);
0;

f3 (a, b, c);
['a, 'v, 'w];

f3 (error (), b, c);
['(error ()), 'v, 'w];

(untrace (f3),
 0);
0;

(timer (f3),
 0);
0;

f3 (a, b, c);
['a, 'v, 'w];

f3 (error (), b, c);
['(error ()), 'v, 'w];

(kill (f3),
 0);
0;

(f4 ('x, y, [z]) := [x, y, z],
 0);
0;

(trace (f4),
 trace_options (f4, noprint),
 0);
0;

f4 (a, b);
['a, 'v, []];

f4 (a, b, c, d);
['a, 'v, ['w, 'x]];

f4 (error (), b, c, d);
['(error ()), 'v, ['w, 'x]];

(untrace (f4),
 0);
0;

(timer (f4),
 0);
0;

f4 (a, b);
['a, 'v, []];

f4 (a, b, c, d);
['a, 'v, ['w, 'x]];

f4 (error (), b, c, d);
['(error ()), 'v, ['w, 'x]];

(kill (f4),
 0);
0;

(f5 (x, 'y, [z]) := [x, y, z],
 0);
0;

(trace (f5),
 trace_options (f5, noprint),
 0);
0;

f5 (a, b);
['u, 'b, []];

f5 (a, b, c, d);
['u, 'b, ['w, 'x]];

f5 (a, error (), c, d);
['u, '(error ()), ['w, 'x]];

(untrace (f5),
 0);
0;

(timer (f5),
 0);
0;

f5 (a, b);
['u, 'b, []];

f5 (a, b, c, d);
['u, 'b, ['w, 'x]];

f5 (a, error (), c, d);
['u, '(error ()), ['w, 'x]];

(kill (f5),
 0);
0;

(f6 (x, y, ['z]) := [x, y, z],
 0);
0;

(trace (f6),
 trace_options (f6, noprint),
 0);
0;

f6 (a, b);
['u, 'v, []];

f6 (a, b, c, d);
['u, 'v, ['c, 'd]];

f6 (a, b, error (), error ());
['u, 'v, ['(error ()), '(error ())]];

(untrace (f6),
 0);
0;

(timer (f6),
 0);
0;

f6 (a, b);
['u, 'v, []];

f6 (a, b, c, d);
['u, 'v, ['c, 'd]];

f6 (a, b, error (), error ());
['u, 'v, ['(error ()), '(error ())]];

(kill (f6),
 0);
0;

(f7 ('x, 'y, ['z]) := [x, y, z],
 0);
0;

(trace (f7),
 trace_options (f7, noprint),
 0);
0;

f7 (a, b);
['a, 'b, []];

f7 (a, b, c, d);
['a, 'b, ['c, 'd]];

f7 (error (), error (), error (), error ());
['(error ()), '(error ()), ['(error ()), '(error ())]];

(untrace (f7),
 0);
0;

(timer (f7),
 0);
0;

f7 (a, b);
['a, 'b, []];

f7 (a, b, c, d);
['a, 'b, ['c, 'd]];

f7 (error (), error (), error (), error ());
['(error ()), '(error ()), ['(error ()), '(error ())]];

(kill (f7),
 0);
0;

(kill (a, b, c, d, u, v, w, x),
 0);
0;

/* SF bug #3963: "trace doesn't detect calls to functions defined by DEFMFUN in Lisp code" */

(S: make_string_output_stream (),
 untrace (atom),
 with_stdout (S, atom(1)),
 get_output_stream_string (S));
"";

(trace (atom),
 with_default_2d_display(with_stdout (S, atom(1))),
 get_output_stream_string (S));
"1 Call   atom [1]
1 Return atom true
";

(untrace (atom),
 trace (?rischint),
 with_stdout (S, block ([display2d: false], risch (2*x, x))),
 get_output_stream_string (S));
"1 Call   rischint [2*x,x]
1 Return rischint (2*x^2)/2
";

(untrace (?rischint),
 trace (integrate, defint, limit, ?antideriv),
 with_stdout (S, block ([display2d: false], integrate (exp(-x)*cos(x), x, 0, inf))),
 get_output_stream_string (S));
"1 Call   integrate [%e^-x*cos(x),x,0,inf]
 1 Call   defint [%e^-x*cos(x),x,0,inf]
  1 Call   limit [0]
  1 Return limit 0
  1 Call   limit [%e^-x,x,inf]
  1 Return limit 0
  1 Call   limit [0]
  1 Return limit 0
  1 Call   antideriv [%e^-x*cos(x),x]
  1 Return antideriv (%e^-x*(sin(x)-cos(x)))/2
  1 Call   limit [0]
  1 Return limit 0
  1 Call   limit [(%e^-x*sin(x))/2-(%e^-x*cos(x))/2,x,0,plus]
   2 Call   limit [zerob]
   2 Return limit 0
  1 Return limit -(1/2)
  1 Call   limit [(%e^-x*sin(x))/2-(%e^-x*cos(x))/2,x,inf,minus]
  1 Return limit 0
 1 Return defint 1/2
1 Return integrate 1/2
";

(untrace (limit, defint),
 with_stdout (S, block ([display2d: false], integrate (exp(-x)*cos(x), x, 0, inf))),
 get_output_stream_string (S));
"1 Call   integrate [%e^-x*cos(x),x,0,inf]
 1 Call   antideriv [%e^-x*cos(x),x]
 1 Return antideriv (%e^-x*(sin(x)-cos(x)))/2
1 Return integrate 1/2
";

(untrace (integrate, ?antideriv),
 with_stdout (S, block ([display2d: false], integrate (exp(-x)*cos(x), x, 0, inf))),
 get_output_stream_string (S));
"";

(close (S), 0);
0;

block ([stream : make_string_output_stream (),
        ret],
  local (foo),

  foo (x, [y]) := cons (x, y),

  trace (foo),

  with_stdout (stream, foo (1, 2, 3)),
  ret : get_output_stream_string (stream),

  untrace (foo),

  ret);
"1 Call   foo [1, 2, 3]
1 Return foo [1, 2, 3]
";

block ([stream : make_string_output_stream (),
        ret],
  trace (block),

  with_stdout (stream, block (1, 2, 3)),
  ret : get_output_stream_string (stream),

  untrace (block),

  ret);
"1 Call   block [1, 2, 3]
1 Return block 3
";

block ([stream : make_string_output_stream (),
        ret],
  trace (block),

  with_stdout (stream, block ([x : 1], x)),
  ret : get_output_stream_string (stream),

  untrace (block),

  ret);
"1 Call   block [[x : 1], x]
1 Return block 1
";

block ([stream : make_string_output_stream (),
        ret],
  trace ("+"),

  with_stdout (stream, 1 + 2 + 3),
  ret : get_output_stream_string (stream),

  untrace ("+"),

  ret);
"1 Simp   \"+\" [1, 2, 3]
1 Return \"+\" 6
";

block ([stream : make_string_output_stream (),
        ret],
  trace ("+"),

  with_stdout (stream, (1 + 2) + 3),
  ret : get_output_stream_string (stream),

  untrace ("+"),

  ret);
"1 Simp   \"+\" [1, 2]
1 Return \"+\" 3
1 Simp   \"+\" [3, 3]
1 Return \"+\" 6
";

block ([stream : make_string_output_stream (),
        ret],
  trace (block, "+"),

  with_stdout (stream, block ([x : 1], x + 3 + 5)),
  ret : get_output_stream_string (stream),

  untrace (block, "+"),

  ret);
"1 Call   block [[x : 1], x + 3 + 5]
 1 Simp   \"+\" [1, 3, 5]
 1 Return \"+\" 9
1 Return block 9
";

block ([stream : make_string_output_stream (),
        display2d : false,
        ret],
  trace (gamma),

  with_stdout (stream, gamma (1/2)),
  ret : get_output_stream_string (stream),

  untrace (gamma),

  ret);
"1 Simp   gamma [1/2]
1 Return gamma sqrt(%pi)
";

block ([stream : make_string_output_stream (),
        display2d : false,
        gamma_expand : true,
        ret],
  trace (gamma),

  with_stdout (stream, gamma (x + 3)),
  ret : get_output_stream_string (stream),

  untrace (gamma),

  ret);
"1 Simp   gamma [x+3]
 2 Simp   gamma [x]
 2 Return gamma gamma(x)
1 Return gamma x*(x+1)*(x+2)*gamma(x)
";

block ([stream : make_string_output_stream (),
        display2d : false,
        ret],
  local (simp_stepfn),

  load ("simplifying"),

  /* step function example from share package simplifying.lisp */

  simp_stepfn(x):=
    block([prederror:false],
      if is(x<=0)=true then 0
      elseif is(x>0)=true then 1
      else simpfuncall('stepfn,x)),

  simplifying('stepfn,'simp_stepfn),

  trace (stepfn),

  with_stdout (stream,
    stepfn (-x^2),
    stepfn (x^2 + 1),
    stepfn (x^2)),
  ret : get_output_stream_string (stream),

  untrace (stepfn),

  kill (stepfn),

  ret);
"1 Simp   stepfn [-x^2]
1 Return stepfn 0
1 Simp   stepfn [x^2+1]
1 Return stepfn 1
1 Simp   stepfn [x^2]
1 Return stepfn stepfn(x^2)
";

(kill (all), 0);
0;

