From 5f4c577d5b9d8d3e846555be01a1ef1dfadc4e56 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Fri, 29 Jul 2011 18:31:10 -0400 Subject: [PATCH] Get rid of pseudo-syntax. --- collects/typed-scheme/optimizer/logging.rkt | 43 +++---------------- .../typed-scheme/optimizer/tool/display.rkt | 19 ++++---- .../typed-scheme/optimizer/tool/report.rkt | 8 ++-- 3 files changed, 19 insertions(+), 51 deletions(-) diff --git a/collects/typed-scheme/optimizer/logging.rkt b/collects/typed-scheme/optimizer/logging.rkt index b9e861ab7b..06f26eb18b 100644 --- a/collects/typed-scheme/optimizer/logging.rkt +++ b/collects/typed-scheme/optimizer/logging.rkt @@ -1,7 +1,7 @@ #lang racket/base -(require racket/set racket/string racket/match racket/list racket/serialize - unstable/syntax unstable/logging syntax/to-string +(require racket/set racket/string racket/match racket/list + unstable/syntax unstable/logging "../utils/tc-utils.rkt") (provide log-optimization log-missed-optimization @@ -10,8 +10,7 @@ with-intercepted-tr-logging with-tr-logging-to-port (struct-out log-entry) (struct-out opt-log-entry) - (struct-out missed-opt-log-entry) - (struct-out pseudo-syntax)) + (struct-out missed-opt-log-entry)) ;;-------------------------------------------------------------------- @@ -27,29 +26,11 @@ (define log-so-far '()) ;; msg is for consumption by the DrRacket tool -;; mutability is there only to replace syntax with pseudo-syntax before -;; printing at the end -(struct log-entry (kind msg (stx #:mutable) (located-stx #:mutable) pos) - #:prefab) +(struct log-entry (kind msg stx located-stx pos) #:prefab) ;; for optimizations only (not missed optimizations, those are below) (struct opt-log-entry log-entry () #:prefab) -;; syntax objects are not serializable. -;; this is a prefab struct that holds the information we need from syntax -;; objects while still being serializable -;; rep : string (result of syntax->string) -(struct pseudo-syntax (rep line column position span - source-directory source-file-name) - #:prefab) -(define (syntax->pseudo-syntax stx) - (pseudo-syntax (syntax->string #`(#,stx)) ; takes a list of stxs - (syntax-line stx) (syntax-column stx) - (syntax-position stx) (syntax-span stx) - (serialize (syntax-source-directory stx)) - (serialize (syntax-source-file-name stx)))) - - (define (log-optimization kind msg stx) (let ([new-entry (opt-log-entry kind msg @@ -72,7 +53,7 @@ ;; that got merged into this miss. we need to keep them around to detect ;; future potential merges. (struct missed-opt-log-entry log-entry - ((irritants #:mutable) (merged-irritants #:mutable) badness) + (irritants merged-irritants badness) #:prefab) (define missed-optimizations-log '()) @@ -233,18 +214,8 @@ (define logger (current-logger)) (add-missed-opts-to-log) (for ([x (sort-log)]) - (define out (format-log-entry x)) - (set-log-entry-stx! x (syntax->pseudo-syntax (log-entry-stx x))) - (set-log-entry-located-stx! x (syntax->pseudo-syntax - (log-entry-located-stx x))) - (when (missed-opt-log-entry? x) - (set-missed-opt-log-entry-irritants! - x (map syntax->pseudo-syntax - (missed-opt-log-entry-irritants x))) - (set-missed-opt-log-entry-merged-irritants! - x (map syntax->pseudo-syntax - (missed-opt-log-entry-merged-irritants x)))) - (log-message logger 'warning out + (log-message logger 'warning + (format-log-entry x) (cons optimization-log-key x)))) (define (clear-log) diff --git a/collects/typed-scheme/optimizer/tool/display.rkt b/collects/typed-scheme/optimizer/tool/display.rkt index d7f62faf04..f63f387070 100644 --- a/collects/typed-scheme/optimizer/tool/display.rkt +++ b/collects/typed-scheme/optimizer/tool/display.rkt @@ -1,10 +1,9 @@ #lang racket/base (require racket/string racket/class racket/gui/base racket/match racket/port - framework + framework syntax/to-string "report.rkt" - unstable/sequence unstable/pretty - typed-scheme/optimizer/logging) ; for pseudo-syntax utils + unstable/sequence unstable/pretty) (provide popup-callback make-color-table) @@ -33,9 +32,7 @@ ;; the location, the syntax and the message are in separate editors (define location-text (new text:basic% [auto-wrap #t])) - (define location (format "~a:~a:" - (pseudo-syntax-line stx) - (pseudo-syntax-column stx))) + (define location (format "~a:~a:" (syntax-line stx) (syntax-column stx))) (send location-text insert-port (open-input-string location)) (send location-text lock #t) ;; add to the main editor @@ -46,14 +43,14 @@ (define syntax-text (new text:basic%)) ;; typeset the syntax as code (send syntax-text change-style tt-style-delta) - (send syntax-text insert-port (open-input-string (pseudo-syntax-rep stx))) + (send syntax-text insert-port + (open-input-string (syntax->string #`(#,stx)))) ; takes a list of stxs ;; circle irritants, if necessary (when (missed-opt-report-entry? s) (for ([i (in-list (missed-opt-report-entry-irritants s))] - #:when (pseudo-syntax-position i)) - (define start (- (pseudo-syntax-position i) - (pseudo-syntax-position stx))) - (define len (pseudo-syntax-span i)) + #:when (syntax-position i)) + (define start (- (syntax-position i) (syntax-position stx))) + (define len (syntax-span i)) ;; will be off if there are comments inside an irritant (span will be ;; higher than what's actually displayed), but unless we make the ;; located version of irritants available, this is the best we can do diff --git a/collects/typed-scheme/optimizer/tool/report.rkt b/collects/typed-scheme/optimizer/tool/report.rkt index 0d6dbe2a71..f27f7cf140 100644 --- a/collects/typed-scheme/optimizer/tool/report.rkt +++ b/collects/typed-scheme/optimizer/tool/report.rkt @@ -1,6 +1,6 @@ #lang racket/base -(require racket/class racket/gui/base racket/match racket/port racket/serialize +(require racket/class racket/gui/base racket/match racket/port unstable/syntax unstable/port racket/sandbox typed-scheme/optimizer/logging (prefix-in tr: typed-scheme/typed-reader)) @@ -38,8 +38,8 @@ (define (right-file? l) ; does the log-entry refer to the file we're in? (define stx (log-entry-stx l)) (define path - (let ([dir (deserialize (pseudo-syntax-source-directory stx))] - [file (deserialize (pseudo-syntax-source-file-name stx))]) + (let ([dir (syntax-source-directory stx)] + [file (syntax-source-file-name stx)]) (if (and dir file) (build-path dir file) #f))) @@ -82,7 +82,7 @@ (match l [(log-entry kind msg stx located-stx (? number? pos)) (define start (sub1 pos)) - (define end (+ start (pseudo-syntax-span stx))) + (define end (+ start (syntax-span stx))) (report-entry (list (if (opt-log-entry? l) (opt-report-entry located-stx msg) (missed-opt-report-entry