suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fixed sprofiler demo

Browse Source 
worked around problem where some syntax objects were getting unwrapped
  (e.g., require)

svn: r3742
This commit is contained in:
Greg Cooper 2006-07-17 16:23:00 +00:00
parent 56de304927
commit e4f5ed700b
2 changed files with 14 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/mztake/debug-tool.ss
View File

@ -20,6 +20,11 @@
(provide tool@)
(define (robust-syntax-source stx)
(if (syntax? stx)
(syntax-source stx)
#f))
; QUESTIONS/IDEAS
; what is the right way to deal with macros?
; how can the three tool classes communicate with each other safely
@ -444,8 +449,8 @@
(if (or (compiled-expression? (if (syntax? orig-exp)
(syntax-e orig-exp)
orig-exp))
(not (syntax-source orig-exp))
(not (eq? (syntax-source orig-exp)
(not (robust-syntax-source orig-exp))
(not (eq? (robust-syntax-source orig-exp)
(send (get-tab) get-defs))))
(oe orig-exp)
(let loop ([exp (if (syntax? orig-exp)
@ -482,8 +487,8 @@
break-after
(lambda (type bound binding)
;(display-results (list bound))
(when (eq? (syntax-source bound)
(syntax-source exp))
(when (eq? (robust-syntax-source bound)
(robust-syntax-source exp))
(let loop ([i 0])
(when (< i (syntax-span bound))
(vector-set! pos-vec (+ i (syntax-position bound)) binding)

6
collects/mztake/demos/sprofiler/sprofiler-mztake.ss
View File

@ -1,6 +1,7 @@
(require (lib "mztake.ss" "mztake" )
(lib "match.ss")
(lib "base-gm.ss" "frtime"))
(lib "base-gm.ss" "frtime")
(only mzscheme hash-table-map))
(set-main! "picture.ss")
@ -20,5 +21,8 @@
(set-running-e! (merge-e (clicks . -=> . false)
(clicks . -=> . true)))
(define (hash-pairs ht)
(hash-table-map ht (lambda (k v) (list k v))))
(define (show-profile)
(sort (hash-pairs pings) (lambda (a b) (> (second a) (second b)))))