; Debug-wrap is one of the most practical functions resulted from ; deliberations on this blog. It is described in this post: ; ; http://kazimirmajorinc.blogspot.com/2008/07/verbose-functions.html ; ; version described in the blog maybe doesn't work any more as it is, ; because Newlisp changed in the meantime. But essence is the same, and ; updated version is in Instprog.default-library.lsp. ; Classical examples are Fibonacci's numbers. (load "http://www.instprog.com/Instprog.default-library.lsp") ; (load "C:\\Newlisp\\Instprog.default-library.lsp") ; (set 'fib (lambda(n)(if (< n 3) 1 (+ (fib (- n 1)) (fib (- n 2)))))) (debug-wrap fib) (fib 5) ; ; Result: ; ; (fib (in 5) ; (fib (in 4) ; (fib (in 3) ; (fib (in 2) ; (out 1)) ; (fib (in 1) ; (out 1)) ; (out 2)); t=22 ; (fib (in 2) ; (out 1)) ; (out 3)); t=43 ; (fib (in 3) ; (fib (in 2) ; (out 1)) ; (fib (in 1) ; (out 1)) ; (out 2)); t=22 ; (out 5)); t=86 ; ; "comments" like t=113 are the time of the evaluation of the function, ; in microseconds .The result is in form of s-expression, because ; that is readable format, and also, because it allows one to inspect ; debugging output in some s-expression aware text editor, that ; can highlight left and right parenths. I had best experiences ; with PLT Scheme editor. Debug-wrap can be applied on macros and ; built in primitives as well. (debug-wrap +) (fib 5) ; (fib (in 5) ; (+ (in (fib (- n 1)) (fib (- n 2))) ; (fib (in 4) ; (+ (in (fib (- n 1)) (fib (- n 2))) ; (fib (in 3) ; (+ (in (fib (- n 1)) (fib (- n 2))) ; (fib (in 2) ; (out 1)) ; (fib (in 1) ; (out 1)) ; (out 2)); t=23 ; (out 2)); t=35 ; (fib (in 2) ; (out 1)) ; (out 3)); t=57 ; (out 3)); t=71 ; (fib (in 3) ; (+ (in (fib (- n 1)) (fib (- n 2))) ; (fib (in 2) ; (out 1)) ; (fib (in 1) ; (out 1)) ; (out 2)); t=21 ; (out 2)); t=34 ; (out 5)); t=131 ; (out 5)); t=141 ; ; OK, it works. But, what will happen if I try something relatively ; naive: ; ; (debug-wrap when) ; ; (fib 5) ;  ; ; Why? The function when is used inside the definition of new, ; debug version of when. So, when calls another instance of when, ; which calls another instance of when and so forth. ; ; So, what is the solution for this case? We'll replace all occurences ; of symbol when in the body of debug-wrap with symbol [when.original]. ; There are few trivial details also. (debug-unwrap fib) (debug-unwrap +) (set '[when.original] when) (set 'debug-wrap (expand debug-wrap '((when [when.original])))) (debug-wrap when) (debug-wrap fib) (fib 5) ; it works. Wrapped when is not problem any more. ; Now, I'll debug-wrap all primitives used in fib: +, - and if. ; I'll use few functions that semi-automatize that. Main idea is ; relatively simple, but there are quite a few technical details. ; My suggestion is - don't bother much about details, just get the ; idea. First, I'll clean the tails left from previous debugging ; sessions of fib. (debug-unwrap when) (debug-unwrap fib) ; Function original accepts symbol, say z as argument and returns ; symbol [z.original] (set 'original (lambda([original.x]) (sym (append "[" (string [original.x]) ".original]")))) ; this loop is equivalent to (set '[+.original] +) and same for ; - and if. (dolist(i '(+ - if)) (if (primitive? (eval i)) (set (original i) (eval i)))) ; The function originalize replace all simbols like + with [+.original] ; in the body of the fname. (set 'originalize (lambda(fname symbolist) (eval (list (if (protected? (eval fname)) 'set 'constant) 'fname (expand (eval fname) (map (lambda(s) ;this map will produce (list s ;((+ [+.original])...) (original s))) symbolist)))))) (originalize 'debug-wrap '(+ - if)) (originalize 'println '(+ - if)) ; I must do that because my library ; redefines println on the way that ; contains if, and if I do not use ; original if, infinite loops is ; created. (originalize 'print '(+ - if)) ; The same as println. (debug-wrap fib) (debug-wrap +) (debug-wrap -) (debug-wrap if) (===) (fib 5) (exit) ; RESULT ; (fib (in 5) ; (if (in (< n 3) 1 (+ (fib (- n 1)) (fib (- n 2)))) ; (+ (in (fib (- n 1)) (fib (- n 2))) ; (- (in n 1) ; (out 4)) ; (fib (in 4) ; (if (in (< n 3) 1 (+ (fib (- n 1)) (fib (- n 2)))) ; (+ (in (fib (- n 1)) (fib (- n 2))) ; (- (in n 1) ; (out 3)) ; (fib (in 3) ; (if (in (< n 3) 1 (+ (fib (- n 1)) (fib (- n 2)))) ; (+ (in (fib (- n 1)) (fib (- n 2))) ; (- (in n 1) ; (out 2)) ; (fib (in 2) ; (if (in (< n 3) 1 (+ (fib (- n 1)) (fib (- n 2)))) ; (out 1)) ; (out 1)); t=10 ; (- (in n 2) ; (out 1)) ; (fib (in 1) ; (if (in (< n 3) 1 (+ (fib (- n 1)) (fib (- n 2)))) ; (out 1)) ; (out 1)); t=14 ; (out 2)); t=64 ; (out 2)); t=78 ; (out 2)); t=89 ; (- (in n 2) ; (out 2)) ; (fib (in 2) ; (if (in (< n 3) 1 (+ (fib (- n 1)) (fib (- n 2)))) ; (out 1)) ; (out 1)); t=11 ; (out 3)); t=143 ; (out 3)); t=153 ; (out 3)); t=164 ; (- (in n 2) ; (out 3)) ; (fib (in 3) ; (if (in (< n 3) 1 (+ (fib (- n 1)) (fib (- n 2)))) ; (+ (in (fib (- n 1)) (fib (- n 2))) ; (- (in n 1) ; (out 2)) ; (fib (in 2) ; (if (in (< n 3) 1 (+ (fib (- n 1)) (fib (- n 2)))) ; (out 1)); t=1 ; (out 1)); t=13 ; (- (in n 2) ; (out 1)) ; (fib (in 1) ; (if (in (< n 3) 1 (+ (fib (- n 1)) (fib (- n 2)))) ; (out 1)) ; (out 1)); t=13 ; (out 2)); t=75 ; (out 2)); t=88 ; (out 2)); t=101 ; (out 5)); t=302 ; (out 5)); t=311 ; (out 5)); t=325 ; ; In next few weeks, I'll integrate all that in the library, so use of the ; debug-wrap will be simpler even when built-in primitives are ; debug-wrapped. |
No comments:
Post a Comment