Verbose Functions and Macros.
; --------------------------------------------------------------
; Back in 1970's, one of the best programmers in the local
; public computer center started to behave on strange way. During
; one of our conversations he said " The highest level of the
; programming is when you do not need computer any more,
; you simply sit on the sofa, eat chips and think how program
; should work. Strange argument, but nevertheless, not illogical.
; Sure, if you use your mind as a computer, you cannot
; really make million calculations in few seconds, but as I
; already knew - results are not important - programs are important.
; I felt that something was wrong about it, but the best critical
; I was able to formulate was: if you write programs in your mind,
; they ALWAYS work, right?
; Very soon, my young friend left programming for good; I didn't
; and my programs still do not work.
; One of the best method for fixing them is to make them not only
; evaluate, but also to produce verbose output similar
; to one I used in my blog article on macros:
; ==============================================================
; (-> min-used-cells 945)
; (-> max-used-cells 945)
; --------------------------------------------------------------
; |||||Macro (fibom2 4) called.
; |||||||||Macro (fibom2 (- ex 1)) called.
; |||||||||||||Macro (fibom2 (- ex 1)) called.
; ||||||||||||||Macro (fibom2 (- ex 1)) returns 1.
; |||||||||||||Macro (fibom2 (- ex 2)) called.
; ||||||||||||||Macro (fibom2 (- ex 2)) returns 1.
; ||||||||||Macro (fibom2 (- ex 1)) returns 2.
; |||||||||Macro (fibom2 (- ex 2)) called.
; ||||||||||Macro (fibom2 (- ex 2)) returns 1.
; ||||||Macro (fibom2 4) returns 3.
; --------------------------------------------------------------
; (-> (fibom2 32) 2178309)
; (-> (time (fibom2 32)) 9734)
; (-> min-used-cells 945)
; (-> max-used-cells 1269)
; ==============================================================
; Everyone likes such outputs. If there is some error, it is
; easier to find it. To achieve that, I wrote the macro fibom2
; on the complicated way:
'(set 'fibom2 (macro(x)
(print-ln (evaluation-level-indent)
"Macro (fibom2 " x ") called.")
(letn ((ex (eval x))
(result (if (< ex 3)
1
(+ (fibom2 (- ex 1))
(fibom2 (- ex 2))))))
(print-ln (evaluation-level-indent)
"Macro (fibom2 " x ") returns " result ".")
(memory-watch)
result)))
; However, the "real" code that evaluates
; Fibonacci numbers is concentrated in the middle, in the part
; (letn ((ex (eval x))
; (result (if (< ex 3)
; 1
; (+ (fibom2 (- ex 1))
; (fibom2 (- ex 2))))))
; So, it might be possible to automatize production of such
; verbose functions, writing macros that turn "normal" functions
; into verbose, and vice-versa. And also, turning normal macros
; in verbose macros and vice versa.
; Also, the output I used in article about macros is not optimal.
; It is nice for small programs, but sometimes, output required
; for debugging could be quite large - thousands of lines, dozens
; of nested function calls. One possibility of the output is in
; use of the nested s-expressions.
'(fibo (in 4)
(caller 4)
(fibo (in 3)
(caller (- x 1))
(fibo (in 2)
(caller (- x 1))
(time 0)
(memory 13 (total 1262))
(out 1))
(fibo (in 1)
(caller (- x 2))
(time 0)
(memory 13 (total 1263))
(out 1))
(time 24)
(memory 13 (total 1200))
(out 2))
(fibo (in 2)
(caller (- x 2))
(time 0)
(memory 13 (total 1201))
(out 1))
(time 49)
(memory 10 (total 1144))
(out 3))
; This is not the code - this is output of the verbose function.
; Now, why such output? Because, if it is very long, and I find
; that some (out x) part is wrong - I can use text editor to
; show me where is appropriate (in ...). For that purpose, editors
; that highlight whole s-expressions, not only parentheses are better.
; This is Dr. Scheme. Such a highlighting is very useful if
; s-expressions are very long.
; the function that produced output above looked like:
(set 'debug-indent 0)
(set 'fibo (lambda-macro ()
'(original-function-definition
(lambda-macro (`x)
(let ((x (eval `x)))
(if (<= x 2)
1
(+ (fibo (- x 1)) (fibo (- x 2)))))))
(let ((t)
(result)
(used-memory (sys-info 0)))
(print (dup " " debug-indent) "(fibo (in")
(doargs (arg)(print " " (eval arg)))
(println ")")
(inc 'debug-indent 6)
(print (dup " " debug-indent) "(caller")
(doargs (arg)(print " " arg))
(println ")")
(set 't (time (set 'result (eval (append (list
; Here is original macro
; ------------------------------------------
(lambda-macro (`x)
(let ((x (eval `x)))
(if (<= x 2)
1
(+ (fibo (- x 1)) (fibo (- x 2))))))
;--------------------------------------------
)(args))))))
(println (dup " " debug-indent)
"(time " t ")\n"
(dup " " debug-indent)
"(memory " (- (sys-info 0) used-memory)
" (total " (sys-info 0) "))\n"
(dup " " debug-indent)
"(out " result "))")
(dec 'debug-indent 6) result)))
(fibo 4)
; It might look complicated - but it is not, it is
; only relatively large - and macros that transform original version
; in the version above are relatively simple.
; I use storing blocks of data into function body, already described
; in one of the previous blogs, so you can scroll
; down until last few paragraphs:
(set 'block?
(lambda()
(and (list? (first (args)))
(not (empty? (first (args)))))))
(set 'get-block-name
(lambda(some-block)
(if (not (block? some-block))
(throw-error (list "get-block-name applied on non-block"
some-block))
(first some-block))))
(set 'quoted-block?
(lambda(argument)
(if (or (quote? argument)
(and (list? argument)
(not (empty? argument))
(= (first argument) 'quote)))
(block? (eval argument)))))
(set 'beginize-block
(lambda(some-block)
(append '(begin)
(rest some-block))))
(set 'get-block-from-list-containing-quoted-blocks
(lambda(block-name L)
(catch (dolist (i L)
(if (and (quoted-block? i)
(= block-name
(get-block-name (eval i))))
(throw (eval i)))))))
(set 'or-function-macro? (lambda(L)
(or (lambda? L) (macro? L))))
(set 'set-quoted-block-in-list
(lambda(b L)
(catch (begin (dolist(i L)
(when (and (quoted-block? i)
(= b (get-block-name (eval i))))
(prinln "set-quoted-block: pronadjen.")
(throw (nth-set (L $idx) b))))
(println "set-quoted-block: nije pronadjen u listi.")
(push (list 'quote b)
L
(if (or-function-macro? L) 1 0))
(println "set-quoted-block-returns " L)))))
(set 'evaluate-block-from-list-containing-quoted-blocks
(lambda (block-name list-containing-quoted-blocks)
(eval (beginize-block
(get-block-from-list-containing-quoted-blocks
block-name
list-containing-quoted-blocks)))))
;---------------------------------------------------------------
; Finally, here are these two macros. Also, global variable, named
; debug-indent has to be maintained, so indents can be more
; precisely calculated.
;===============================================================
; DEBUG-WRAP & DEBUG-UNWRAP
; usage: (debug-wrap <function-name>)
; (debug-unwrap <function-name>)
(set 'blank (lambda(x)(dup " " x)))
(set 'debug-indent 0)
(set 'debug-wrap
(lambda-macro()
(letn ((`function-name (first (args)))
(function-name (eval `function-name))
(debug-indent-step (+ (length (string `function-name))
2))
(in-line (append "(" (string `function-name) " (in")))
(set `function-name
(expand
(lambda-macro()
'(original-function-definition function-name)
(let ((t)
(result)
(used-memory-before)
(used-memory-after))
(print (blank debug-indent) in-line)
(doargs(arg/debug-wrap)
(print " " (eval arg/debug-wrap)))
(println ")")
(inc 'debug-indent debug-indent-step)
(print (blank debug-indent) "(caller")
(doargs(arg/debug-wrap)
(print " " arg/debug-wrap))
(println ")")
(set 'used-memory-before (sys-info 0))
(set 't
(time (set 'result
(eval (cons function-name
(args))))))
(set 'used-memory-after (sys-info 0))
(println (blank debug-indent)
"(time " t ")\n"
(blank debug-indent)
"(memory " (- used-memory-after
used-memory-before)
" (total " (sys-info 0) "))\n"
(blank debug-indent)
"(out " result "))")
(dec 'debug-indent debug-indent-step)
result))
'function-name
'debug-indent-step
'in-line)))))
(set 'debug-unwrap
(lambda-macro()
(letn ((`function-name (first (args)))
(function-name (eval `function-name)))
(set `function-name
(evaluate-block-from-list-containing-quoted-blocks
'original-function-definition
function-name)))))
;===============================================================
(set 'fibo (lambda(x)(if (>= x 3)
(+ (fibo (- x 1))
(fibo (- x 2)))
1)))
(println "debug-wrap test --------------------------------------")
(debug-wrap fibo)
(fibo 4)
;Output is as follows:
; (fibo (in 4)
; (caller 4)
; (fibo (in 3)
; (caller (- x 1))
; (fibo (in 2)
; (caller (- x 1))
; (time 0)
; (memory 0 (total 1079))
; (out 1))
; (fibo (in 1)
; (caller (- x 2))
; (time 0)
; (memory 0 (total 1080))
; (out 1))
; (time 3)
; (memory 0 (total 1029))
; (out 2))
; (fibo (in 2)
; (caller (- x 2))
; (time 0)
; (memory 0 (total 1030))
; (out 1))
; (time 8)
; (memory 0 (total 983))
; (out 3))
;
(println "debug-unwrap test ------------------------------------")
(debug-unwrap fibo)
(println (fibo 4)) ; 3
; And it appears it works. I tested these two macros, debug-wrap
; and debug-unwrap not only on functions, but on macros also, and
; also on the functions and macros that use arguments from (args)
; and it also worked.
; Dr Scheme "program counture" shows 550 lines output of "verbose" (fibo 10).
; It should be pretty because the ratio between (fibo n) and (fibo (- n 1)), always
; called in pairs converges toward golden ratio. Is it pretty?
; One possible improvement could be writing in the file instead on the screen.
; The debug-wrap and debug-unwrap demonstrate one advantage of the Newlisp.
; The macros can be switched from "normal" to "verbose" versions and back automatically
; because they are the first class citizens, so they can be arguments
; of debug-wrap and debug-unwrap.
No comments:
Post a Comment