hi folks!
I got extremely painful when I's tracing a complicated procedure. So I
decided to do something to alleviate this pain.
And I added a new print style for the REPL trace. It'll show level count
number instead lots of "| | |......" which makes me drag my console
window very very long. But this patch won't eliminate all the tracing pains
as all guys think.
And Andy Wingo encourage me to make this count style as default, so I did.
Anyway, there's an option for old style I'll show you later.
here is a example for this patch:
------------------count style (default)--------------------
scheme@(guile-user)> ,trace (format #t "~a" 1)
trace: 1: (#<procedure a2b94d0> #(#<directory (guile-user) a13a630> #f #f))
trace: 1: #(#<directory (guile-user) a13a630> format "~a")
trace: (#<procedure a30ff70 at <current input>:1:0 ()>)
trace: (#<procedure a291470 at ice-9/format.scm:1612:9 (destination
format-string . args) | (deprecated-forma…> …)
trace: 1: (string? #t)
trace: 1: #f
trace: (format #t "~a" 1)
trace: 1: (string? "~a")
trace: 1: #t
trace: 1: (boolean? #t)
trace: 1: #t
trace: 1: (b #<autoload (ice-9 i18n) a29df78> current-output-port #f)
trace: 2: (memq current-output-port (%global-locale number->locale-string))
trace: 2: #f
...
trace: 3: (list-ref (1) 0)
trace: 3: 1
trace: 3: (format:out-obj-padded #f 1 #f ())
trace: 4: (with-output-to-string #<procedure a5d2cb0 at
ice-9/format.scm:782:44 ()>)
trace: 4: (call-with-output-string #<procedure a5dccc0 at
ice-9/r4rs.scm:238:3 (p)>)
trace: 5: (#<procedure a5dccc0 at ice-9/r4rs.scm:238:3 (p)> #<output:
string a5ebe10>)
trace: 5: (with-output-to-port #<output: string a5ebe10> #<procedure
a5d2cb0 at ice-9/format.sc…>)
trace: 6: (swaports)
trace: 7: (set-current-output-port #<output: string a5ebe10>)
trace: 7: #<output: file /dev/pts/12>
trace: 6: #<unspecified>
trace: 6: (#<procedure a607af0>)
...
-------------------end----------------------
But you may use the old style whose name is "graph":
-----------------graph style----------------
,trace (format #t "~a" 1) #:mode graph
trace: | (#<procedure a693c60> #(#<directory (guile-user) a13a630> #f #f))
trace: | #(#<directory (guile-user) a13a630> format "~a")
trace: (#<procedure a6988e0 at <current input>:1:0 ()>)
trace: (#<procedure a291470 at ice-9/format.scm:1612:9 (destination
format-string . args) | (deprecated-forma…> …)
trace: | (string? #t)
trace: | #f
trace: (format #t "~a" 1)
trace: | (string? "~a")
trace: | #t
...
trace: | (format:format-work "~a" (1))
trace: | | (string-length "~a")
trace: | | 2
trace: | | (length (1))
trace: | | 1
trace: | | (anychar-dispatch)
trace: | | | (string-ref "~a" 0)
trace: | | | #\~
trace: | | | (char=? #\~ #\~)
trace: | | | #t
trace: | | (tilde-dispatch)
trace: | | | (string-ref "~a" 1)
trace: | | | #\a
trace: | | | (char-upcase #\a)
trace: | | | #\A
trace: | | | (memq #f (colon colon-at))
trace: | | | #f
trace: | | | (memq #f (at colon-at))
trace: | | | #f
trace: | | | (list-ref (1) 0)
trace: | | | 1
trace: | | | (format:out-obj-padded #f 1 #f ())
trace: | | | | (with-output-to-string #<procedure a756850 at
ice-9/format.scm:782:44 ()>)
trace: | | | | (call-with-output-string #<procedure a7609f0 at
ice-9/r4rs.scm:238:3 (p)>)
trace: | | | | | (#<procedure a7609f0 at ice-9/r4rs.scm:238:3 (p)>
#<output: string a768708>)
trace: | | | | | (with-output-to-port #<output: string a768708>
#<procedure a756850 at ice…>)
trace: | | | | | | (swaports)
trace: | | | | | | | (set-current-output-port #<output: string
a768708>)
trace: | | | | | | | #<output: file /dev/pts/12>
trace: | | | | | | #<unspecified>
trace: | | | | | | (#<procedure a77e380>)
trace: | | | | | | (() ((filename . "ice-9/r4rs.scm") (0 176 . 19) (3
176 . 41) (11 176 . 30)) ((2 13 …)) …)
trace: | | | | | | (#<procedure a7923a0>)
trace: | | | | | | (() ((filename . "ice-9/r4rs.scm") (0 176 . 19) (3
176 . 41) (11 176 . 30)) ((2 13 …)) …)
trace: | | | | | | (#<procedure a756850 at ice-9/format.scm:782:44
()>)
trace: | | | | | | (display 1)
trace: | | | | | | #<unspecified>
trace: | | | | | | (swaports)
trace: | | | | | | | (set-current-output-port #<output: file
/dev/pts/12>)
trace: | | | | | | | #<output: string a768708>
trace: | | | | | | #<unspecified>
trace: | | | | | #<unspecified>
trace: | | | | "1"
trace: | | | | (display "1" #<output: file /dev/pts/12>)
1trace: | | | | #<unspecified>
trace: | | | | (string-length "1")
trace: | | | | 1
trace: | | | #<unspecified>
...
---------------end-----------------
What you guys think?
From 5da4ee03faadffd59fcbdd6faf976216e6c4978a Mon Sep 17 00:00:00 2001
From: NalaGinrut <nalagin...@gmail.com>
Date: Tue, 28 Feb 2012 17:45:08 +0800
Subject: [PATCH] Add new trace print style, show level count number instead lots of '| | |...'
modified: module/system/vm/trace.scm
---
module/system/vm/trace.scm | 55 ++++++++++++++++++++++++++++++++------------
1 files changed, 40 insertions(+), 15 deletions(-)
diff --git a/module/system/vm/trace.scm b/module/system/vm/trace.scm
index 2dad376..99f28ca 100644
--- a/module/system/vm/trace.scm
+++ b/module/system/vm/trace.scm
@@ -36,17 +36,23 @@
;; FIXME: this constant needs to go in system vm objcode
(define *objcode-header-len* 8)
-(define (print-application frame depth width prefix)
+(define (print-application frame depth width prefix mode)
(format (current-error-port) "~a~a~v:@y\n"
prefix
(let lp ((depth depth) (s ""))
(if (zero? depth)
s
- (lp (1- depth) (string-append "| " s))))
+ (case mode
+ ((graph)
+ (lp (1- depth) (string-append "| " s)))
+ ((count)
+ (format #f "~a: ~a" depth s))
+ (else
+ (error "invalid print mode" mode)))))
(max (- width (* 3 depth)) 1)
(frame-call-representation frame)))
-(define (print-return frame depth width prefix)
+(define* (print-return frame depth width prefix mode)
(let* ((len (frame-num-locals frame))
(nvalues (frame-local-ref frame (1- len))))
(cond
@@ -56,7 +62,13 @@
(let lp ((depth depth) (s ""))
(if (zero? depth)
s
- (lp (1- depth) (string-append "| " s))))
+ (case mode
+ ((graph)
+ (lp (1- depth) (string-append "| " s)))
+ ((count)
+ (format #f "~a: ~a" depth s))
+ (else
+ (error "invalid print mode" mode)))))
width (frame-local-ref frame (- len 2))))
(else
;; this should work, but there appears to be a bug
@@ -66,31 +78,38 @@
(let lp ((depth depth) (s ""))
(if (zero? depth)
s
- (lp (1- depth) (string-append "| " s))))
+ (case mode
+ ((graph)
+ (lp (1- depth) (string-append "| " s)))
+ ((count)
+ (format #f "~a: ~a" depth s))
+ (else
+ (error "invalid print mode" mode)))))
nvalues
(map (lambda (val)
(format #f "~v:@y" width val))
(frame-return-values frame)))))))
(define* (trace-calls-to-procedure proc #:key (width 80) (vm (the-vm))
- (prefix "trace: "))
+ (prefix "trace: ") (mode 'count))
(define (apply-handler frame depth)
- (print-application frame depth width prefix))
+ (print-application frame depth width prefix mode))
(define (return-handler frame depth)
- (print-return frame depth width prefix))
+ (print-return frame depth width prefix mode))
(trap-calls-to-procedure proc apply-handler return-handler
#:vm vm))
(define* (trace-calls-in-procedure proc #:key (width 80) (vm (the-vm))
- (prefix "trace: "))
+ (prefix "trace: ") (mode 'count))
(define (apply-handler frame depth)
- (print-application frame depth width prefix))
+ (print-application frame depth width prefix mode))
(define (return-handler frame depth)
- (print-return frame depth width prefix))
+ (print-return frame depth width prefix mode))
(trap-calls-in-dynamic-extent proc apply-handler return-handler
#:vm vm))
-(define* (trace-instructions-in-procedure proc #:key (width 80) (vm (the-vm)))
+(define* (trace-instructions-in-procedure proc #:key (width 80) (vm (the-vm))
+ (mode 'count))
(define (trace-next frame)
(let* ((ip (frame-instruction-pointer frame))
(objcode (program-objcode (frame-procedure frame)))
@@ -104,17 +123,23 @@
;; Note that because this procedure manipulates the VM trace level
;; directly, it doesn't compose well with traps at the REPL.
;;
-(define* (call-with-trace thunk #:key (calls? #t) (instructions? #f) (width 80) (vm (the-vm)))
+;; mode has two options:
+;; 1. 'graph for old style which print "| " msg
+;; 2. 'count for new style which print level count number + msg
+;; The 'count style is aim to alleviate the pain when tracing very deep level.
+(define* (call-with-trace thunk #:key (calls? #t) (instructions? #f)
+ (width 80) (mode 'count) (vm (the-vm)))
(let ((call-trap #f)
(inst-trap #f))
(dynamic-wind
(lambda ()
(if calls?
(set! call-trap
- (trace-calls-in-procedure thunk #:vm vm #:width width)))
+ (trace-calls-in-procedure thunk #:vm vm #:width width #:mode mode)))
(if instructions?
(set! inst-trap
- (trace-instructions-in-procedure thunk #:vm vm #:width width)))
+ (trace-instructions-in-procedure thunk #:vm vm #:width width
+ #:mode mode)))
(set-vm-trace-level! vm (1+ (vm-trace-level vm))))
thunk
(lambda ()
--
1.7.0.4
