1#lang racket
2(require syntax/readerr
3         (prefix-in arith: "arith.rkt"))
4
5(provide (rename-out [$-read read]
6                     [$-read-syntax read-syntax]))
7
8(define ($-read in)
9  (parameterize ([current-readtable (make-$-readtable)])
10    (read in)))
11
12(define ($-read-syntax src in)
13  (parameterize ([current-readtable (make-$-readtable)])
14    (read-syntax src in)))
15
16(define (make-$-readtable)
17  (make-readtable (current-readtable)
18                  #\$ 'terminating-macro read-dollar))
19
20(define read-dollar
21  (case-lambda
22   [(ch in)
23    (check-$-after (arith:read in) in (object-name in))]
24   [(ch in src line col pos)
25    (check-$-after (arith:read-syntax src in) in src)]))
26
27(define (check-$-after val in src)
28  (regexp-match #px"^\\s*" in) ; skip whitespace
29  (let ([ch (peek-char in)])
30    (unless (equal? ch #\$) (bad-ending ch src in))
31    (read-char in))
32  val)
33
34(define (bad-ending ch src in)
35  (let-values ([(line col pos) (port-next-location in)])
36    ((if (eof-object? ch)
37         raise-read-error
38         raise-read-eof-error)
39     "expected a closing `$'"
40     src line col pos
41     (if (eof-object? ch) 0 1))))
42