Go back to previous expansion strategy.

The DrRacket expansion functions don't offer anything more than plain
expand + a sandbox, and using them made the code less readable.

This reverts commit 96eee2b317.
This reverts commit 19ce4d44a5.
This reverts commit 58fbd8ba75.
This reverts commit b305ea9c62.
This reverts commit 860feb30ae.

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

@@ -2,7 +2,7 @@
 
 (require racket/string racket/class racket/gui/base racket/match racket/port
          framework syntax/to-string
-         "report-structs.rkt"
+         "report.rkt"
          unstable/sequence unstable/pretty)
 
 (provide popup-callback make-color-table)

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

@@ -1,3 +0,0 @@
-#lang racket/signature
-
-generate-report

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

@@ -1,18 +0,0 @@
-#lang racket/base
-
-(provide (struct-out report-entry)
-         (struct-out sub-report-entry)
-         (struct-out opt-report-entry)
-         (struct-out missed-opt-report-entry))
-
-;; Similar to the log-entry family of structs, but geared towards GUI display.
-;; Also designed to contain info for multiple overlapping log entries.
-;; - subs is a list of sub-report-entry, corresponding to all the entries
-;;   between start and end
-;; - badness is 0 for a report-entry containing only optimizations
-;;   otherwise, it's the sum for all the subs
-(struct report-entry (subs start end badness))
-;; multiple of these can be contained in a report-entry
-(struct sub-report-entry (stx msg))
-(struct opt-report-entry        sub-report-entry ())
-(struct missed-opt-report-entry sub-report-entry (badness irritants))

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

@@ -1,51 +1,38 @@
-#lang racket/unit
+#lang racket/base
 
 (require racket/class racket/gui/base racket/match
-         unstable/syntax drracket/tool
+         unstable/syntax)
-         unstable/logging)
 
-(require typed-scheme/optimizer/logging
+(require (prefix-in tr: typed-scheme/typed-reader)
-         "report-sig.rkt" "report-structs.rkt")
+         typed-scheme/optimizer/logging)
 
-(import drracket:tool^)
+(provide (struct-out report-entry)
-(export report^)
+         (struct-out sub-report-entry)
+         (struct-out opt-report-entry)
+         (struct-out missed-opt-report-entry)
+         generate-report)
 
+;; Similar to the log-entry family of structs, but geared towards GUI display.
+;; Also designed to contain info for multiple overlapping log entries.
+;; - subs is a list of sub-report-entry, corresponding to all the entries
+;;   between start and end
+;; - badness is 0 for a report-entry containing only optimizations
+;;   otherwise, it's the sum for all the subs
+(struct report-entry (subs start end badness))
+;; multiple of these can be contained in a report-entry
+(struct sub-report-entry (stx msg))
+(struct opt-report-entry        sub-report-entry ())
+(struct missed-opt-report-entry sub-report-entry (badness irritants))
 
 (define (generate-report this)
   (collapse-report (log->report (generate-log this))))
 
 
 (define (generate-log this)
-
-  ;; expand and capture log messages
-  (define log '())
-  (define listener #f)
-  (define exception #f)
-  (define done-chan (make-channel))
-  (drracket:eval:expand-program
-   (drracket:language:make-text/pos
-    this 0 (send this last-position))
-   (send this get-next-settings) #t
-   (lambda () ; init
-     (uncaught-exception-handler
-      (lambda (e)
-        (set! exception e) ; something went wrong, save exception and die
-        (channel-put done-chan 'done) ; let the rest of the program carry on
-        (custodian-shutdown-all (current-custodian)))) ; kill ourselves
-     (set! listener (start-recording #:level 'warning)))
-   (lambda () ; kill
-     (channel-put done-chan 'done))
-   (lambda (term k)
-     (if (eof-object? term)
-         (begin (set! log (stop-recording listener)) ; done, stash the log
-                (channel-put done-chan 'done))
-         (k)))) ; not done, keep going
-  (channel-get done-chan) ; wait for expansion to finish
-
-  (when exception ; something went wrong, will be caught upstream
-    (raise exception))
-
   (define portname (send this get-port-name))
+  (define input    (open-input-text-editor this))
+  (port-count-lines! input)
+  (define log '())
   (define unsaved-file?
     (and (symbol? portname)
          (regexp-match #rx"^unsaved-editor" (symbol->string portname))))
@@ -64,10 +51,8 @@
            (not f)]
           [else ; different file
            #f]))
-
+  (with-intercepted-tr-logging
-  (define (post-process-log-entry l)
+   (lambda (l)
-    ;; make sure the message is indeed from the optimizer
-    (cond [(log-message-from-tr-opt? 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)
@@ -75,15 +60,13 @@
                       (build-path (syntax-source-directory stx)
                                   (syntax-source-file-name stx))
                       #f))
-           ;; it also needs to come from the right file
+     (when (right-file? path)
-           (if (right-file? path)
+       (set! log (cons log-entry-data log))))
-               log-entry-data ; payload
+   (lambda ()
-               #f)]
+     (parameterize ([current-namespace  (make-base-namespace)]
-          [else #f])) ; drop it
+                    [read-accept-reader #t])
-
+       (expand (tr:read-syntax portname input)))))
-  (for/list ([l (in-list (map post-process-log-entry log))]
+  log)
-             #:when l)
-    l))
 
 ;; converts log-entry structs to report-entry structs for further
 ;; processing

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

@@ -3,7 +3,7 @@
 (require racket/class racket/port racket/list racket/match
          racket/gui/base racket/unit drracket/tool)
 
-(require "display.rkt" "report-sig.rkt" "report.rkt" "report-structs.rkt")
+(require "report.rkt" "display.rkt")
 
 (provide performance-report-drracket-button
          tool@)
@@ -17,21 +17,7 @@
 
 ;; performance-report-callback : drracket:unit:frame<%> -> void
 (define (performance-report-callback drr-frame)
-  (with-handlers
+  (send (send drr-frame get-definitions-text) add-highlights))
-      ([exn?
-        ;; typechecking failed, report in the interactions window
-        (lambda (e)
-          (define interactions (send drr-frame get-interactions-text))
-          (send interactions reset-console)
-          (send interactions run-in-evaluation-thread (lambda () (raise e))))])
-    (send (send drr-frame get-definitions-text) add-highlights)))
-
-(define-unit pre-tool@
-  (import drracket:tool^ report^)
-  (export drracket:tool-exports^)
-
-  (define (phase1) (void))
-  (define (phase2) (void))
 
 (define highlights-mixin
   (mixin ((class->interface text%)) ()
@@ -78,12 +64,12 @@
 
     (super-new)))
 
-  (drracket:get/extend:extend-definitions-text highlights-mixin))
+(define-unit tool@
-
-(define-compound-unit/infer tool@
   (import drracket:tool^)
   (export drracket:tool-exports^)
-  (link pre-tool@ report@))
+  (define (phase1) (void))
+  (define (phase2) (void))
+  (drracket:get/extend:extend-definitions-text highlights-mixin))
 
 (define performance-report-drracket-button
   (list