Have log entries carry pseudo-syntax instead of syntax.

Unlike syntax, pseudo-syntax is serializable, and it only carries the
information that Performance Report needs. Serializability is
necessary to be able to expand the program inside a sandbox and get
log entries out.

collects/typed-scheme/optimizer/logging.rkt

@@ -1,7 +1,7 @@
 #lang racket/base
 
-(require racket/set racket/string racket/match racket/list
-         unstable/syntax unstable/logging
+(require racket/set racket/string racket/match racket/list racket/serialize
+         unstable/syntax unstable/logging syntax/to-string
          "../utils/tc-utils.rkt")
 
 (provide log-optimization log-missed-optimization
@@ -10,7 +10,8 @@
          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 missed-opt-log-entry)
+         (struct-out pseudo-syntax))
 
 ;;--------------------------------------------------------------------
 
@@ -26,11 +27,29 @@
 (define log-so-far '())
 
 ;; msg is for consumption by the DrRacket tool
-(struct log-entry (kind msg stx located-stx pos) #:prefab)
+;; 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)
 ;; 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
@@ -53,7 +72,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 merged-irritants badness)
+        ((irritants #:mutable) (merged-irritants #:mutable) badness)
         #:prefab)
 
 (define missed-optimizations-log '())
@@ -214,8 +233,18 @@
   (define logger (current-logger))
   (add-missed-opts-to-log)
   (for ([x (sort-log)])
-    (log-message logger 'warning
-                 (format-log-entry x)
+    (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
                  (cons optimization-log-key x))))
 
 (define (clear-log)

collects/typed-scheme/optimizer/tool/display.rkt

@@ -1,9 +1,10 @@
 #lang racket/base
 
 (require racket/string racket/class racket/gui/base racket/match racket/port
-         framework syntax/to-string
+         framework
          "report.rkt"
-         unstable/sequence unstable/pretty)
+         unstable/sequence unstable/pretty
+         typed-scheme/optimizer/logging) ; for pseudo-syntax utils
 
 (provide popup-callback make-color-table)
 
@@ -32,7 +33,9 @@
 
   ;; 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:" (syntax-line stx) (syntax-column stx)))
+  (define location (format "~a:~a:"
+                           (pseudo-syntax-line stx)
+                           (pseudo-syntax-column stx)))
   (send location-text insert-port (open-input-string location))
   (send location-text lock #t)
   ;; add to the main editor
@@ -43,14 +46,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 (syntax->string #`(#,stx)))) ; takes a list of stxs
+  (send syntax-text insert-port (open-input-string (pseudo-syntax-rep stx)))
   ;; circle irritants, if necessary
   (when (missed-opt-report-entry? s)
     (for ([i (in-list (missed-opt-report-entry-irritants s))]
-          #:when (syntax-position i))
-      (define start (- (syntax-position i) (syntax-position stx)))
-      (define len   (syntax-span i))
+          #:when (pseudo-syntax-position i))
+      (define start (- (pseudo-syntax-position i)
+                       (pseudo-syntax-position stx)))
+      (define len   (pseudo-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

collects/typed-scheme/optimizer/tool/report.rkt

@@ -1,6 +1,6 @@
 #lang racket/base
 
-(require racket/class racket/gui/base racket/match
+(require racket/class racket/gui/base racket/match racket/serialize
          unstable/syntax)
 
 (require (prefix-in tr: typed-scheme/typed-reader)
@@ -55,11 +55,12 @@
    (lambda (l)
      (define log-entry-data (cdr (vector-ref l 2))) ; log-entry struct
      (define stx (log-entry-stx log-entry-data))
-     (define path (if (and (syntax-source-directory stx)
-                           (syntax-source-file-name stx))
-                      (build-path (syntax-source-directory stx)
-                                  (syntax-source-file-name stx))
-                      #f))
+     (define path
+       (if (and (pseudo-syntax-source-directory stx)
+                (pseudo-syntax-source-file-name stx))
+           (build-path (deserialize (pseudo-syntax-source-directory stx))
+                       (deserialize (pseudo-syntax-source-file-name stx)))
+           #f))
      (when (right-file? path)
        (set! log (cons log-entry-data log))))
    (lambda ()
@@ -75,7 +76,7 @@
     (match l
       [(log-entry kind msg stx located-stx (? number? pos))
        (define start     (sub1 pos))
-       (define end       (+ start (syntax-span stx)))
+       (define end       (+ start (pseudo-syntax-span stx)))
        (report-entry (list (if (opt-log-entry? l)
                                (opt-report-entry located-stx msg)
                                (missed-opt-report-entry