reduce-historical/r38/packages/rtrace/rtrace.rlg

REDUCE Development Version, Mon Dec 21 14:11:25 1998 ...




% rtrace.tst -- Test portable REDUCE tracing

% Author: Francis J. Wright, 13 July 1998

symbolic procedure test(a, b);
   begin scalar c, d;
      d := c := {a, b};
      return c
   end$



rtr test;


(test)

getd 'test;


(expr lambda (a b) (run!-rtraced!-procedure (quote test) (quote (a b)) (list a b
)))

prop 'test;


((rtraced!-procedure expr lambda (a b) (prog (c d) (setq d (setq c (list a b))) (
return c))) (number!-of!-args . 2))

test('a, 'b);

Enter (1) test
   a:  a$
   b:  b$
Leave (1) test = [a,b]$

(a b)


rtrst test;

*** Trace mode of test changed.
(test)

getd 'test;


(expr lambda (a b) (run!-rtraced!-procedure (quote test) (quote (a b)) (list a b
)))

prop 'test;


((rtraced!-setq . t) (rtraced!-procedure expr lambda (a b) (prog (c d) (
rtraced!-setq d (rtraced!-setq c (list a b))) (return c))) (number!-of!-args . 2
))

test('a, 'b);

Enter (1) test
   a:  a$
   b:  b$
d := c := [a,b]$
Leave (1) test = [a,b]$

(a b)


unrtr test;


(test)

getd 'test;


(expr lambda (a b) (prog (c d) (setq d (setq c (list a b))) (return c)))

prop 'test;


((number!-of!-args . 2))

test('a, 'b);


(a b)


algebraic procedure test(a, b);
   begin scalar c, d;
      d := c := {a, b};
      return c
   end$


+++ test redefined


rtr test;


(test)

getd 'test;


(expr lambda (a b) (run!-rtraced!-procedure (quote test) (quote (a b)) (list a b
)))

prop 'test;


((rtraced!-procedure expr lambda (a b) (prog (c d) (setq d (setq c (aeval (list (
quote list) a b)))) (return (aeval c)))) (opfn . t) (number!-of!-args . 2))

test(a, b);

Enter (1) test
   a:  a$
   b:  b$
Leave (1) test = {a,b}$

{a,b}


rtrst test;

*** Trace mode of test changed.
(test)

getd 'test;


(expr lambda (a b) (run!-rtraced!-procedure (quote test) (quote (a b)) (list a b
)))

prop 'test;


((rtraced!-setq . t) (rtraced!-procedure expr lambda (a b) (prog (c d) (
rtraced!-setq d (rtraced!-setq c (aeval (list (quote list) a b)))) (return (
aeval c)))) (opfn . t) (number!-of!-args . 2))

test(a, b);

Enter (1) test
   a:  a$
   b:  b$
d := c := {a,b}$
Leave (1) test = {a,b}$

{a,b}


unrtr test;


(test)

getd 'test;


(expr lambda (a b) (prog (c d) (setq d (setq c (aeval (list (quote list) a b))))
(return (aeval c))))

prop 'test;


((number!-of!-args . 2) (opfn . t))

test(a, b);


{a,b}


algebraic procedure test(a, b);
   d := c := {a, b}$


+++ test redefined


rtr test;


(test)

getd 'test;


(expr lambda (a b) (run!-rtraced!-procedure (quote test) (quote (a b)) (list a b
)))

prop 'test;


((rtraced!-procedure expr lambda (a b) (setk (quote d) (setk (quote c) (aeval (
list (quote list) a b))))) (number!-of!-args . 2) (opfn . t))

test(a, b);

Enter (1) test
   a:  a$
   b:  b$
Leave (1) test = {a,b}$

{a,b}


rtrst test;

*** Trace mode of test changed.
(test)

getd 'test;


(expr lambda (a b) (run!-rtraced!-procedure (quote test) (quote (a b)) (list a b
)))

prop 'test;


((rtraced!-setq . t) (rtraced!-procedure expr lambda (a b) (rtraced!-setk (quote
d) (rtraced!-setk (quote c) (aeval (list (quote list) a b))))) (number!-of!-args
. 2) (opfn . t))

test(a, b);

Enter (1) test
   a:  a$
   b:  b$
c := {a,b}$
d := {a,b}$
Leave (1) test = {a,b}$

{a,b}


unrtr test;


(test)

getd 'test;


(expr lambda (a b) (setk (quote d) (setk (quote c) (aeval (list (quote list) a b
)))))

prop 'test;


((number!-of!-args . 2) (opfn . t))

test(a, b);


{a,b}



% Examples used in documentation (rtrace.tex):

algebraic procedure power(x, n);
   if n = 0 then 1 else x*power(x, n-1)$



rtr power;


(power)

power(x+1, 2);

Enter (1) power
   x:  x + 1$
   n:  2$
Enter (2) power
   x:  x + 1$
   n:  1$
Enter (3) power
   x:  x + 1$
   n:  0$
Leave (3) power = 1$
Leave (2) power = x + 1$
Leave (1) power = x**2 + 2*x + 1$

 2
x  + 2*x + 1

off rtrace;


power(x+1, 2);

Enter (1) power
   x:  (plus x 1)
   n:  2
Enter (2) power
   x:  (plus x 1)
   n:  1
Enter (3) power
   x:  (plus x 1)
   n:  0
Leave (3) power = 1
Leave (2) power = (!*sq ((((x . 1) . 1) . 1) . 1) t)
Leave (1) power = (!*sq ((((x . 2) . 1) ((x . 1) . 2) . 1) . 1) t)

 2
x  + 2*x + 1

on rtrace;


unrtr power;


(power)


rtr int;


(simpint)

unrtr int;


(simpint)


procedure fold u;
   for each x in u sum x$



rtrst fold;


(fold)

fold {z, z*y, y};

Enter (1) fold
   u:  {z,y*z,y}$
x := [z,y*z,y]$
g0 := 0$
g0 := z$
x := [y*z,y]$
g0 := z*(y + 1)$
x := [y]$
g0 := y*z + y + z$
x := []$
Leave (1) fold = y*z + y + z$

y*z + y + z

unrtrst fold;


(fold)


trigrules := {sin(~x)^2 => 1 - cos(x)^2};


                     2              2
trigrules := {sin(~x)  => 1 - cos(x) }


let trigrules;



trrl trigrules;


1 - sin(x)^2;

Rule trigrules.1: sin(x)**2 => 1 - cos(x)**2$

      2
cos(x)

untrrl trigrules;



trrl sin;


1 - sin(x)^2;

Rule sin.23: sin(x)**2 => 1 - cos(x)**2$

      2
cos(x)

untrrl sin;



clearrules trigrules;



trrlid trigrules;


1 - sin(x)^2 where trigrules;

Rule trigrules.1: sin(x)**2 => 1 - cos(x)**2$

      2
cos(x)

untrrlid trigrules;



end;



Time for test: 120 ms