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