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

Call locate-stx at the last minute, to avoid overeager duplicate detection.

Browse Source
This commit is contained in:
Vincent St-Amour 2011-07-08 11:44:24 -04:00
parent 34ccf6a3fb
commit d2a8a620b1
1 changed files with 3 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/typed-scheme/optimizer/logging.rkt
View File

@ -31,8 +31,7 @@
(define (log-optimization kind msg stx) (define (log-optimization kind msg stx)
(let* ([stx (locate-stx stx)] (let ([new-entry (opt-log-entry kind msg stx (syntax-position stx))])
[new-entry (opt-log-entry kind msg stx (syntax-position stx))])
(set! log-so-far (cons new-entry log-so-far)))) (set! log-so-far (cons new-entry log-so-far))))
;;-------------------------------------------------------------------- ;;--------------------------------------------------------------------
@ -92,8 +91,7 @@
;; Attempts to merge the incoming missed optimization with existing ones. ;; Attempts to merge the incoming missed optimization with existing ones.
;; Otherwise, adds the new one to the log. ;; Otherwise, adds the new one to the log.
(define (log-missed-optimization kind msg stx [irritants '()]) (define (log-missed-optimization kind msg stx [irritants '()])
(let* ([stx (locate-stx stx)] (let* (;; for convenience, if a single irritant is given, wrap it in a list
;; for convenience, if a single irritant is given, wrap it in a list
;; implicitly ;; implicitly
[irritants (if (list? irritants) irritants (list irritants))] [irritants (if (list? irritants) irritants (list irritants))]
[new [new
@ -186,7 +184,7 @@
;; For command-line printing purposes. ;; For command-line printing purposes.
;; Not as user friendly as what's produced by the DrRacket tool. ;; Not as user friendly as what's produced by the DrRacket tool.
(define (format-log-entry entry) (define (format-log-entry entry)
(define stx (log-entry-stx entry)) (define stx (locate-stx (log-entry-stx entry)))
(define msg (define msg
(format "~a ~a ~s -- ~a" (format "~a ~a ~s -- ~a"
(syntax-source-file-name stx) (syntax-source-file-name stx)