Check-in [927509fadb]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:small fix to print-stack-trace
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 927509fadb27d92885ecc6d30505e4757aa6f7f5
User & Date: aldo 2017-01-11 17:49:26
Context
2017-01-11
17:53
small fix to print-stack-trace check-in: 07ac33f7e0 user: aldo tags: trunk
17:49
small fix to print-stack-trace check-in: 927509fadb user: aldo tags: trunk
17:46
added print-stack-trace and read-string to thunder-utils.sls check-in: 0e61d1648b user: aldo tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to thunder-utils.sls.

62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
     [() (read-string #f)]
     [(n) (read-string n (current-input-port))]
     [(n port)
      (if n
	  (get-string-n port n)
	  (get-string-all port))]))

  (define (print-stack-trace depth)
    (printf "stack-trace:\n")
    (call/cc 
     (lambda (k)
       (let loop ((cur (inspect/object k))
		  (i 0))
	 (if (and (< i depth)
		  (> (cur 'depth) 1))
	     (let* ([name (cond [((cur 'code) 'name) => (lambda (x) x)]
				[else "*"])]
		    [source ((cur 'code) 'source)]
		    [source-txt (if source
				    (let ([ss (with-output-to-string
						(lambda ()
						  (source 'write (current-output-port))))])
					  (if (> (string-length ss) 50)
					      (string-truncate! ss 50)
					      ss))
				    "*")])
	       (call-with-values
		   (lambda () (cur 'source-path))
		 (case-lambda
		  [() (printf "[no source] [~a]: ~a\n" name source-txt)]
		  [(fn bfp) (printf "~a char ~a [~a]: ~a\n" fn bfp name source-txt)]
		  [(fn line char) (printf "~a:~a:~a [~a]: ~a\n" fn line char name source-txt)]))
	       (loop (cur 'link) (+ i 1)))))))
    (printf "stack-trace end.\n"))

  );library








|

<
<
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|




62
63
64
65
66
67
68
69
70


71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
     [() (read-string #f)]
     [(n) (read-string n (current-input-port))]
     [(n port)
      (if n
	  (get-string-n port n)
	  (get-string-all port))]))

  (define (print-stack-trace k depth)
    (printf "stack-trace:\n")


    (let loop ((cur (inspect/object k))
	       (i 0))
      (if (and (< i depth)
	       (> (cur 'depth) 1))
	  (let* ([name (cond [((cur 'code) 'name) => (lambda (x) x)]
			     [else "*"])]
		 [source ((cur 'code) 'source)]
		 [source-txt (if source
				 (let ([ss (with-output-to-string
					     (lambda ()
					       (source 'write (current-output-port))))])
				   (if (> (string-length ss) 50)
				       (string-truncate! ss 50)
				       ss))
				 "*")])
	    (call-with-values
		(lambda () (cur 'source-path))
	      (case-lambda
		[() (printf "[no source] [~a]: ~a\n" name source-txt)]
		[(fn bfp) (printf "~a char ~a [~a]: ~a\n" fn bfp name source-txt)]
		[(fn line char) (printf "~a:~a:~a [~a]: ~a\n" fn line char name source-txt)]))
	    (loop (cur 'link) (+ i 1)))))
    (printf "stack-trace end.\n"))

  );library