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

Simplify log sorting.

Browse Source
This commit is contained in:
Vincent St-Amour 2011-06-03 18:05:54 -04:00
parent 8d2f66faa6
commit e095976c8b
1 changed files with 16 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -14,7 +14,7 @@
(format "~a:~a" line col) (format "~a:~a" line col)
"(no location)"))) "(no location)")))
(struct log-entry (msg line col) #:transparent) (struct log-entry (msg pos) #:transparent)
;; to identify log messages that come from the optimizer ;; to identify log messages that come from the optimizer
;; to be stored in the data section of log messages ;; to be stored in the data section of log messages
@ -36,9 +36,7 @@
(define (do-logging msg stx) (define (do-logging msg stx)
(let* ([new-message (gen-log-message msg stx)] (let* ([new-message (gen-log-message msg stx)]
[new-entry (log-entry new-message [new-entry (log-entry new-message (syntax-position stx))])
(syntax-line stx)
(syntax-column stx))])
(unless (set-member? log-so-far new-entry) (unless (set-member? log-so-far new-entry)
(set! log-so-far (set-add log-so-far new-entry))))) (set! log-so-far (set-add log-so-far new-entry)))))
@ -53,25 +51,20 @@
(for-each (lambda (x) (log-message logger 'warning (log-entry-msg x) (for-each (lambda (x) (log-message logger 'warning (log-entry-msg x)
optimization-log-key)) optimization-log-key))
(sort (set->list log-so-far) (sort (set->list log-so-far)
(lambda (x y) (match-lambda*
(match* (x y) [(list (log-entry msg-x pos-x) (log-entry msg-y pos-y))
[((log-entry msg-x line-x col-x) (cond [(not (or pos-x pos-y))
(log-entry msg-y line-y col-y))
(cond [(not (or line-x line-y))
;; neither have location, sort by message ;; neither have location, sort by message
(string<? msg-x msg-y)] (string<? msg-x msg-y)]
[(not line-y) #f] [(not pos-y) #f]
[(not line-x) #t] [(not pos-x) #t]
[else [else
;; both have location ;; both have location
(let* ([loc-x (+ (* 1000 line-x) col-x)] (cond [(= pos-x pos-y)
;; 1000 is a conservative bound
[loc-y (+ (* 1000 line-y) col-y)])
(cond [(= loc-x loc-y)
;; same location, sort by message ;; same location, sort by message
(string<? msg-x msg-y)] (string<? msg-x msg-y)]
;; sort by source location ;; sort by source location
[else (< loc-x loc-y)]))])]))))) [else (< pos-x pos-y)])])]))))
(define (clear-log) (define (clear-log)
(set! log-so-far (set)) (set! log-so-far (set))
(set! missed-optimizations-log '())) (set! missed-optimizations-log '()))