add syntactic shorthand for `report`

sugar/debug.rkt

@@ -5,3 +5,80 @@
 (provide+safe report report/line report/file
               report* report*/line report*/file
               report-apply repeat time-repeat time-repeat* compare)
+
+
+
+(module reader racket/base
+  (require syntax/module-reader racket/syntax)  
+  (provide (rename-out [debug-read read]
+                       [debug-read-syntax read-syntax]
+                       [debug-get-info get-info]))
+  
+  (define (make-debug-readtable [rt (current-readtable)])
+    (make-readtable rt
+                    #\^ 'non-terminating-macro report-proc))
+
+  
+  (define (wrap-reader reader)
+    (define (rd . args)
+      (define intro (make-syntax-introducer))
+      (parameterize ([current-readtable (make-debug-readtable (current-readtable))]
+                     [current-syntax-introducer intro])
+        (define stx (apply reader args))
+        (if (syntax? stx)
+            (intro stx)
+            stx)))
+    rd)
+
+  
+  (define current-syntax-introducer
+    (make-parameter (λ (x) x)))
+
+  
+  (define (report-proc c in src ln col pos)
+    (define c2 (peek-char in))
+    (define c3 (peek-char in 1))
+    (define intro (current-syntax-introducer))
+    (cond [(and (char=? c3 #\^) (char=? c2 #\^))
+           (read-char in)
+           (read-char in)
+           (define/with-syntax stx (intro (read-syntax/recursive src in)))
+           (intro
+            #'(let ()
+                (local-require (only-in sugar/debug [report/file report/file]))
+                (report/file stx)))]
+          [(char=? c2 #\^)
+           (read-char in)
+           (define/with-syntax stx (intro (read-syntax/recursive src in)))
+           (intro
+            #'(let ()
+                (local-require (only-in sugar/debug [report/line report/line]))
+                (report/line stx)))]
+          [else
+           (define/with-syntax stx (intro (read-syntax/recursive src in)))
+           (intro
+            #'(let ()
+                (local-require (only-in sugar/debug [report report]))
+                (report stx)))]))
+
+  
+  (define-values (debug-read debug-read-syntax debug-get-info)
+    (make-meta-reader
+     'sugar/debug/lang
+     "language path"
+     (lambda (bstr)
+       (let* ([str (bytes->string/latin-1 bstr)]
+              [sym (string->symbol str)])
+         (and (module-path? sym)
+              (vector
+               ;; try submod first:
+               `(submod ,sym reader)
+               ;; fall back to /lang/reader:
+               (string->symbol (string-append str "/lang/reader"))))))
+     wrap-reader
+     wrap-reader
+     (lambda (proc)
+       (lambda (key defval)
+         (define (fallback) (if proc (proc key defval) defval))
+         (case key
+           [else (fallback)]))))))

sugar/debug/lang/lang/reader.rkt

@@ -1,28 +0,0 @@
-(module reader racket/base
-  (require syntax/module-reader
-           (only-in "../../reader.rkt" make-debug-readtable wrap-reader))
-  
-  (provide (rename-out [debug-read read]
-                       [debug-read-syntax read-syntax]
-                       [debug-get-info get-info]))
-  
-  (define-values (debug-read debug-read-syntax debug-get-info)
-    (make-meta-reader
-     'sugar/debug/lang
-     "language path"
-     (lambda (bstr)
-       (let* ([str (bytes->string/latin-1 bstr)]
-              [sym (string->symbol str)])
-         (and (module-path? sym)
-              (vector
-               ;; try submod first:
-               `(submod ,sym reader)
-               ;; fall back to /lang/reader:
-               (string->symbol (string-append str "/lang/reader"))))))
-     wrap-reader
-     wrap-reader
-     (lambda (proc)
-       (lambda (key defval)
-         (define (fallback) (if proc (proc key defval) defval))
-         (case key
-           [else (fallback)]))))))

sugar/debug/reader.rkt

@@ -1,42 +0,0 @@
-#lang racket/base
-
-(provide make-debug-readtable wrap-reader)
-
-(require racket/syntax)
-
-(define (make-debug-readtable [rt (current-readtable)])
-  (make-readtable rt
-    #\^ 'dispatch-macro report-proc
-    ))
-
-(define current-syntax-introducer
-  (make-parameter (λ (x) x)))
-
-(define (report-proc c in src ln col pos)
-  (define c2 (peek-char in))
-  (define intro (current-syntax-introducer))
-  (cond [(char=? c2 #\^)
-         (read-char in)
-         (define/with-syntax stx (intro (read-syntax/recursive src in)))
-         (intro
-          #'(let ()
-              (local-require (only-in sugar/debug [report/line report/line]))
-              (report/line stx)))]
-        [else
-         (define/with-syntax stx (intro (read-syntax/recursive src in)))
-         (intro
-          #'(let ()
-              (local-require (only-in sugar/debug [report report]))
-              (report stx)))]))
-
-(define (wrap-reader reader)
-  (define (rd . args)
-    (define intro (make-syntax-introducer))
-    (parameterize ([current-readtable (make-debug-readtable (current-readtable))]
-                   [current-syntax-introducer intro])
-      (define stx (apply reader args))
-      (if (syntax? stx)
-          (intro stx)
-          stx)))
-  rd)
-

sugar/test/debug-meta-lang.rkt

@@ -1,4 +1,4 @@
-#lang sugar/debug/lang racket
+#lang sugar/debug racket
 (require rackunit)
 (let ([out (open-output-string)]
       [let "something else"]
@@ -6,10 +6,10 @@
       [only-in "completely unexpected!"]
       [report "well, not really"])
   (parameterize ([current-error-port out])
-    #^5)
+    ^5)
   (check-equal? (get-output-string out) "5 = 5\n"))
 (let ([out (open-output-string)]
       [report/line "outta the blue!"])
   (parameterize ([current-error-port out])
-    #^^5)
+    ^^5)
   (check-equal? (get-output-string out) "5 = 5 on line 14\n"))

typed/sugar/debug.rkt

@@ -29,7 +29,7 @@
      (with-syntax ([file (syntax-source #'expr)]
                    [line (syntax-line #'expr)])
        #'(let ([expr-result expr])
-           (eprintf "~a = ~v on line ~v in \"~a\"\n" 'name expr-result line file)
+           (eprintf "~a = ~v on line ~v in \"~a\"\n" 'name expr-result line 'file)
            expr-result))]))