Automated Resyntax fixes

drracket-core-lib/drracket/drracket.rkt

@@ -30,29 +30,26 @@
                     (define vec (sync evt))
                     (define str (vector-ref vec 1))
                     (when (regexp-match #rx"^cm: *compil(ing|ed)" str)
-                      (display str)
-                      (newline))
+                      (displayln str))
                     (loop))))))
 
 (cond
   [debugging?
    (flprintf "PLTDRDEBUG: loading CM to load/create errortrace zos\n")
-   (let-values ([(zo-compile
-                  make-compilation-manager-load/use-compiled-handler)
-                 (parameterize ([current-namespace (make-base-empty-namespace)]
-                                [use-compiled-file-paths '()])
-                   (values
-                    (dynamic-require 'errortrace/zo-compile 'zo-compile)
-                    (dynamic-require 'compiler/cm 'make-compilation-manager-load/use-compiled-handler)))])
-     (flprintf "PLTDRDEBUG: installing CM to load/create errortrace zos\n")
-     (current-compile zo-compile)
-     (use-compiled-file-paths (list (build-path compiled-dir "errortrace")))
-     (current-load/use-compiled (make-compilation-manager-load/use-compiled-handler))
-     (error-display-handler (dynamic-require 'errortrace/errortrace-lib
-                                             'errortrace-error-display-handler))
-     (when cm-trace?
-       (flprintf "PLTDRDEBUG: enabling CM tracing\n")
-       (run-trace-thread)))]
+   (define-values (zo-compile make-compilation-manager-load/use-compiled-handler)
+     (parameterize ([current-namespace (make-base-empty-namespace)]
+                    [use-compiled-file-paths '()])
+       (values (dynamic-require 'errortrace/zo-compile 'zo-compile)
+               (dynamic-require 'compiler/cm 'make-compilation-manager-load/use-compiled-handler))))
+   (flprintf "PLTDRDEBUG: installing CM to load/create errortrace zos\n")
+   (current-compile zo-compile)
+   (use-compiled-file-paths (list (build-path compiled-dir "errortrace")))
+   (current-load/use-compiled (make-compilation-manager-load/use-compiled-handler))
+   (error-display-handler (dynamic-require 'errortrace/errortrace-lib
+                                           'errortrace-error-display-handler))
+   (when cm-trace?
+     (flprintf "PLTDRDEBUG: enabling CM tracing\n")
+     (run-trace-thread))]
   [install-cm?
    (flprintf "PLTDRCM: loading compilation manager\n")
    (define make-compilation-manager-load/use-compiled-handler
@@ -91,13 +88,12 @@
       (for/list ([x (in-list (find-relevant-directories (list id)))])
         (define proc (get-info/full x))
         (if proc
-            (map (λ (dirs)
-                   (apply build-path
-                          x
-                          (if (list? dirs)
-                              dirs
-                              (list dirs))))
-                 (proc id (λ () '())))
+            (for/list ([dirs (in-list (proc id (λ () '())))])
+              (apply build-path
+                     x
+                     (if (list? dirs)
+                         dirs
+                         (list dirs))))
             '()))))
 
    (define make-compilation-manager-load/use-compiled-handler

drracket-core-lib/drracket/sprof.rkt

@@ -16,13 +16,11 @@
               (sleep pause-time)
               (define new-traces
                 (map (λ (t) (continuation-mark-set->context (continuation-marks t))) (get-threads)))
-              (for-each (λ (trace)
-                          (for-each (λ (line)
-                                      (hash-set! traces-table
-                                                 line
-                                                 (cons trace (hash-ref traces-table line '()))))
-                                    trace))
-                        new-traces)
+              (for ([trace (in-list new-traces)])
+                (for-each
+                 (λ (line)
+                   (hash-set! traces-table line (cons trace (hash-ref traces-table line '()))))
+                 trace))
               (cond
                 [(zero? i)
                  (update-gui traces-table)
@@ -38,8 +36,8 @@
      (format "~a:~a~a"
              (cond
                [(path? (srcloc-source src))
-                (let-values ([(base name dir?) (split-path (srcloc-source src))])
-                  name)]
+                (define-values (base name dir?) (split-path (srcloc-source src)))
+                name]
                [else (srcloc-source src)])
              (if (srcloc-line src)
                  (format "~a:~a" (srcloc-line src) (srcloc-column src))
@@ -108,14 +106,14 @@
         [(send event button-up? 'left)
          (define admin (get-admin))
          (when admin
-           (let ([dc (send admin get-dc)])
-             (let-values ([(x y) (dc-location-to-editor-location (send event get-x)
-                                                                 (send event get-y))])
-               (let* ([loc (find-position x y)]
-                      [para (position-paragraph loc)])
-                 (set! clicked-srcloc-pr
-                       (and (<= 0 para (last-paragraph)) (car (list-ref gui-display-data para))))
-                 (update-gui-display)))))]
+           (send admin get-dc)
+           (define-values (x y)
+             (dc-location-to-editor-location (send event get-x) (send event get-y)))
+           (define loc (find-position x y))
+           (define para (position-paragraph loc))
+           (set! clicked-srcloc-pr
+                 (and (<= 0 para (last-paragraph)) (car (list-ref gui-display-data para))))
+           (update-gui-display))]
         [else (void)]))
 
     (define/public (set-gui-display-data/refresh traces-table)
@@ -138,35 +136,34 @@
       (set! clear-old-pr void)
       (define denom-ht (make-hasheq))
       (define filtered-gui-display-data
-        (map (λ (pr)
-               (let ([id (car pr)]
-                     [stacks (filter-stacks (cdr pr))])
-                 (for-each (λ (stack) (hash-set! denom-ht stack #t)) stacks)
-                 (cons id stacks)))
-             gui-display-data))
+        (for/list ([pr (in-list gui-display-data)])
+          (define id (car pr))
+          (define stacks (filter-stacks (cdr pr)))
+          (for-each (λ (stack) (hash-set! denom-ht stack #t)) stacks)
+          (cons id stacks)))
       (define denom-count (hash-count denom-ht))
       (let loop ([prs filtered-gui-display-data]
                  [first? #t]
                  [i 0])
         (cond
           [(null? prs) (void)]
           [else
-           (let* ([pr (car prs)]
-                  [fn (car pr)]
-                  [count (length (cdr pr))])
-             (cond
-               [(zero? count) (loop (cdr prs) first? i)]
-               [else
-                (unless first?
-                  (insert "\n"))
-                (let ([before (last-position)])
-                  (hash-set! line-to-source i pr)
-                  (insert (format-percentage (/ count denom-count)))
-                  (insert (format " ~a" (format-fn-name fn)))
-                  (let ([after (last-position)])
-                    (when (equal? (car pr) clicked-srcloc-pr)
-                      (set! clear-old-pr (highlight-range before after "NavajoWhite")))))
-                (loop (cdr prs) #f (+ i 1))]))]))
+           (define pr (car prs))
+           (define fn (car pr))
+           (define count (length (cdr pr)))
+           (cond
+             [(zero? count) (loop (cdr prs) first? i)]
+             [else
+              (unless first?
+                (insert "\n"))
+              (let ([before (last-position)])
+                (hash-set! line-to-source i pr)
+                (insert (format-percentage (/ count denom-count)))
+                (insert (format " ~a" (format-fn-name fn)))
+                (let ([after (last-position)])
+                  (when (equal? (car pr) clicked-srcloc-pr)
+                    (set! clear-old-pr (highlight-range before after "NavajoWhite")))))
+              (loop (cdr prs) #f (+ i 1))])]))
       (lock #t)
       (end-edit-sequence)
       (update-info-editor clicked-srcloc-pr)
@@ -373,11 +370,10 @@
           (define/public (get-threads-to-profile)
             (define thds '())
             (let loop ([cust (get-user-custodian)])
-              (for-each (λ (obj)
-                          (cond
-                            [(custodian? obj) (loop obj)]
-                            [(thread? obj) (set! thds (cons obj thds))]))
-                        (custodian-managed-list cust system-custodian)))
+              (for ([obj (in-list (custodian-managed-list cust system-custodian))])
+                (cond
+                  [(custodian? obj) (loop obj)]
+                  [(thread? obj) (set! thds (cons obj thds))])))
             thds)
 
           ;; FIX

drracket-test/tests/drracket/private/drracket-test-util.rkt

@@ -11,9 +11,8 @@
          "gui.rkt"
          "no-fw-test-util.rkt")
 
-  (provide/contract 
-   [use-get/put-dialog (-> (-> any) path? void?)]
-   [set-module-language! (->* () (boolean?) void?)])
+  (provide (contract-out [use-get/put-dialog (-> (-> any) path? void?)]
+                         [set-module-language! (->* () (boolean?) void?)]))
 
   (provide queue-callback/res
            fire-up-drracket-and-run-tests
@@ -60,25 +59,25 @@
   ;; filename is a string naming a file that should be typed into the dialog
   (define (use-get/put-dialog open-dialog filename)
     (not-on-eventspace-handler-thread 'use-get/put-dialog)
-    (let ([drs (wait-for-drracket-frame)])
-      (with-handlers ([(lambda (x) #t)
-		       (lambda (x)
-			 (fw:preferences:set 'framework:file-dialogs 'std)
-			 (raise x))])
-	(fw:preferences:set 'framework:file-dialogs 'common)
-	(open-dialog)
-	(let ([dlg (wait-for-new-frame drs)])
-	  (send (find-labelled-window "Filename:" #f (fw:test:get-active-top-level-window)) focus)
-	  (fw:test:keystroke #\a (list (case (system-type)
-					 [(windows) 'control]
-					 [(macosx macos) 'meta]
-					 [(unix) 'control]
-                                         [else (error 'use-get/put-dialog "unknown platform: ~s\n"
-                                                      (system-type))])))
-	  (for-each fw:test:keystroke (string->list (path->string filename)))
-	  (fw:test:button-push "OK")
-	  (wait-for-new-frame dlg))
-	(fw:preferences:set 'framework:file-dialogs 'std))))
+    (define drs (wait-for-drracket-frame))
+    (with-handlers ([(lambda (x) #t) (lambda (x)
+                                       (fw:preferences:set 'framework:file-dialogs 'std)
+                                       (raise x))])
+      (fw:preferences:set 'framework:file-dialogs 'common)
+      (open-dialog)
+      (let ([dlg (wait-for-new-frame drs)])
+        (send (find-labelled-window "Filename:" #f (fw:test:get-active-top-level-window)) focus)
+        (fw:test:keystroke
+         #\a
+         (list (case (system-type)
+                 [(windows) 'control]
+                 [(macosx macos) 'meta]
+                 [(unix) 'control]
+                 [else (error 'use-get/put-dialog "unknown platform: ~s\n" (system-type))])))
+        (for-each fw:test:keystroke (string->list (path->string filename)))
+        (fw:test:button-push "OK")
+        (wait-for-new-frame dlg))
+      (fw:preferences:set 'framework:file-dialogs 'std)))
 
   (define (test-util-error fmt . args)
     (raise (make-exn (apply fmt args) (current-continuation-marks))))
@@ -90,10 +89,7 @@
   (define (wait-for-drracket-frame [print-message? #f])
     (define (wait-for-drracket-frame-pred)
       (define active (fw:test:get-active-top-level-window))
-      (if (and active
-               (drracket-frame? active))
-          active
-          #f))
+      (and (and active (drracket-frame? active)) active))
     (define drr-fr
       (or (wait-for-drracket-frame-pred)
           (begin
@@ -116,10 +112,7 @@
                          (for/or ([eventspace (in-list extra-eventspaces)]) 
                            (parameterize ([current-eventspace eventspace])
                              (fw:test:get-active-top-level-window)))))
-      (if (and active
-               (not (eq? active old-frame)))
-          active
-          #f))
+      (and (and active (not (eq? active old-frame))) active))
     (define lab (send old-frame get-label))
     (define fr (poll-until 
                 (procedure-rename wait-for-new-frame-pred
@@ -167,34 +160,29 @@
     (poll-until wait-for-computation-to-finish 60)
     (sync (system-idle-evt)))
 
-  (define do-execute 
-    (case-lambda
-     [(frame)
-      (do-execute frame #t)]
-     [(frame wait-for-finish?)
-      (not-on-eventspace-handler-thread 'do-execute)
-      (queue-callback/res (λ () (verify-drracket-frame-frontmost 'do-execute frame)))
-      (let ([button (queue-callback/res (λ () (send frame get-execute-button)))])
-	(fw:test:run-one (lambda () (send button command)))
-	(when wait-for-finish?
-          (wait-for-computation frame)))]))
+  (define (do-execute frame [wait-for-finish? #t])
+    (not-on-eventspace-handler-thread 'do-execute)
+    (queue-callback/res (λ () (verify-drracket-frame-frontmost 'do-execute frame)))
+    (let ([button (queue-callback/res (λ () (send frame get-execute-button)))])
+      (fw:test:run-one (lambda () (send button command)))
+      (when wait-for-finish?
+        (wait-for-computation frame))))
 
   (define (verify-drracket-frame-frontmost function-name frame)
     (on-eventspace-handler-thread 'verify-drracket-frame-frontmost)
-    (let ([tl (fw:test:get-active-top-level-window)])
-      (unless (and (eq? frame tl)
-                   (drracket-frame? tl))
-        (error function-name "drracket frame not frontmost: ~e (found ~e)" frame tl))))
+    (define tl (fw:test:get-active-top-level-window))
+    (unless (and (eq? frame tl) (drracket-frame? tl))
+      (error function-name "drracket frame not frontmost: ~e (found ~e)" frame tl)))
 
   (define (clear-definitions frame)
     (queue-callback/res (λ () (verify-drracket-frame-frontmost 'clear-definitions frame)))
     (fw:test:new-window (queue-callback/res (λ () (send frame get-definitions-canvas))))
     (let ([window (queue-callback/res (λ () (send frame get-edit-target-window)))])
-      (let-values ([(cw ch) (queue-callback/res (λ () (send window get-client-size)))]
-                   [(w h) (queue-callback/res (λ () (send window get-size)))])
-        (fw:test:mouse-click 'left
-			     (inexact->exact (floor (+ cw (/ (- w cw) 2))))
-			     (inexact->exact (floor (+ ch (/ (- h ch) 2)))))))
+      (define-values (cw ch) (queue-callback/res (λ () (send window get-client-size))))
+      (define-values (w h) (queue-callback/res (λ () (send window get-size))))
+      (fw:test:mouse-click 'left
+                           (inexact->exact (floor (+ cw (/ (- w cw) 2))))
+                           (inexact->exact (floor (+ ch (/ (- h ch) 2))))))
     (fw:test:menu-select "Edit" "Select All")
     (fw:test:menu-select "Edit" (if (eq? (system-type) 'macos)
 				    "Clear"
@@ -217,38 +205,38 @@
     (not-on-eventspace-handler-thread 'put-in-frame)
     (unless (and (object? frame) (is-a? frame top-level-window<%>))
       (error who "expected a frame or a dialog as the first argument, got ~e" frame))
-    (let ([str (if (string? str/sexp)
-		   str/sexp
-		   (let ([port (open-output-string)])
-		     (parameterize ([current-output-port port])
-		       (write str/sexp port))
-		     (get-output-string port)))])
-      (queue-callback/res (λ () (verify-drracket-frame-frontmost who frame)))
-      (let ([canvas (queue-callback/res (λ () (get-canvas frame)))])
-	(fw:test:new-window canvas)
-	(let ([editor (queue-callback/res (λ () (send canvas get-editor)))])
-          (cond
-            [just-insert? 
-             (let ([s (make-semaphore 0)])
-               (queue-callback
-                (λ () 
-                  (send editor set-caret-owner #f)
-                  (send editor insert str)
-                  (semaphore-post s)))
-               (unless (sync/timeout 3 s)
-                 (error who "callback didn't run for 3 seconds; trying to insert ~s" str/sexp)))]
-            [else 
-             (queue-callback/res (λ () (send editor set-caret-owner #f)))
-             (type-string str)])))))
+    (define str
+      (if (string? str/sexp)
+          str/sexp
+          (let ([port (open-output-string)])
+            (parameterize ([current-output-port port])
+              (write str/sexp port))
+            (get-output-string port))))
+    (queue-callback/res (λ () (verify-drracket-frame-frontmost who frame)))
+    (define canvas (queue-callback/res (λ () (get-canvas frame))))
+    (fw:test:new-window canvas)
+    (define editor (queue-callback/res (λ () (send canvas get-editor))))
+    (cond
+      [just-insert?
+       (let ([s (make-semaphore 0)])
+         (queue-callback (λ ()
+                           (send editor set-caret-owner #f)
+                           (send editor insert str)
+                           (semaphore-post s)))
+         (unless (sync/timeout 3 s)
+           (error who "callback didn't run for 3 seconds; trying to insert ~s" str/sexp)))]
+      [else
+       (queue-callback/res (λ () (send editor set-caret-owner #f)))
+       (type-string str)]))
 
   (define (alt-return-in-interactions frame)
     (not-on-eventspace-handler-thread 'alt-return-in-interactions)
     (queue-callback/res (λ () (verify-drracket-frame-frontmost 'alt-return-in-interactions frame)))
-    (let ([canvas (send frame get-interactions-canvas)])
-      (fw:test:new-window canvas)
-      (let ([editor (send canvas get-editor)])
-        (send editor set-caret-owner #f)
-        (fw:test:keystroke #\return '(alt)))))
+    (define canvas (send frame get-interactions-canvas))
+    (fw:test:new-window canvas)
+    (define editor (send canvas get-editor))
+    (send editor set-caret-owner #f)
+    (fw:test:keystroke #\return '(alt)))
 
   ;; type-string : string -> void
   ;; to call test:keystroke repeatedly with the characters

drracket-tool-lib/drracket/private/standalone-module-browser.rkt

@@ -1272,7 +1272,8 @@
                     [(null? ms) (substring short-name 0 (min 2 (string-length short-name)))]
                     [else
                      (apply string-append
-                            (cons (substring short-name 0 1) (map (λ (x) (substring x 1 2)) ms)))])])]
+                            (substring short-name 0 1)
+                            (map (λ (x) (substring x 1 2)) ms))])])]
               [(long) word]
               [(very-long) (string-append word ": " (format "~s" require-phases))]))
            last-name]))