1#lang racket/base
2(require "config.rkt"
3         "special.rkt"
4         "wrap.rkt"
5         "readtable.rkt"
6         "delimiter.rkt"
7         "consume.rkt"
8         "accum-string.rkt"
9         "error.rkt"
10         "parameter.rkt"
11         "number.rkt")
12
13(provide read-symbol-or-number)
14
15(define (read-symbol-or-number init-c in orig-config
16                               ;; `mode` can be 'symbol-or-number,
17                               ;; 'symbol, 'symbol/indirect, 'keyword,
18                               ;; or a number prefix string like "#e";
19                               ;; only the 'symbol-or-number and
20                               ;; 'symbol modes use a readtable's
21                               ;; symbol handler
22                               #:mode [mode 'symbol-or-number]
23                               #:extra-prefix [extra-prefix #f])
24  (define config (if (string? mode)
25                     (override-parameter read-cdot orig-config #f)
26                     orig-config))
27  (define rt (read-config-readtable config))
28  (cond
29   [(and rt
30         (or (eq? mode 'symbol-or-number)
31             (eq? mode 'symbol/indirect))
32         (readtable-symbol-parser rt))
33    => (lambda (handler)
34         (readtable-apply handler init-c in
35                          config
36                          (read-config-line config)
37                          (read-config-col config)
38                          (read-config-pos config)))]
39   [else
40    (define accum-str (accum-string-init! config))
41    (define quoted-ever? #f)
42    (define case-sens? (check-parameter read-case-sensitive config))
43    (when extra-prefix
44      (accum-string-add! accum-str extra-prefix))
45    (define source (read-config-source config))
46
47    ;; If we encounter an EOF or special in the wrong place:
48    (define (unexpected-quoted c after-c)
49      (reader-error in config
50                    #:due-to c
51                    "~a following `~a` in ~a"
52                    (if (eof-object? c) "end-of-file" "non-character")
53                    after-c (cond
54                             [(eq? mode 'keyword) "keyword"]
55                             [(string? mode) "number"]
56                             [else "symbol"])))
57
58    (let loop ([init-c init-c]
59               [pipe-quote-c #f] ; currently quoting?
60               [foldcase-from 0]) ; keep track of range to foldcase for case-insens
61      (define c (or init-c (peek-char/special in config 0 source)))
62      (define ec (readtable-effective-char rt c))
63      (cond
64       [(and pipe-quote-c
65             (not (char? ec)))
66        ;; Interrupted while in quoting mode
67        (unless init-c (consume-char/special in config c))
68        (unexpected-quoted c pipe-quote-c)]
69       [(and (not pipe-quote-c)
70             (readtable-char-delimiter? rt c config))
71        ;; EOF or other delimiter - done!
72        (unless case-sens?
73          (accum-string-convert! accum-str string-foldcase foldcase-from))]
74       [(and pipe-quote-c
75             (char=? c pipe-quote-c)) ; note: `pipe-quote-c` determines close, not readtable
76        ;; End quoting mode
77        (unless init-c (consume-char in c))
78        (loop #f #f (accum-string-count accum-str))]
79       [(and (char=? ec #\|)
80             (check-parameter read-accept-bar-quote config))
81        ;; Start quoting mode
82        (unless init-c (consume-char in c))
83        (set! quoted-ever? #t)
84        (unless case-sens?
85          (accum-string-convert! accum-str string-foldcase foldcase-from))
86        (loop #f c (accum-string-count accum-str))]
87       [(and (char=? ec #\\)
88             (not pipe-quote-c))
89        ;; Single-character quoting
90        (unless init-c (consume-char in c))
91        (define next-c (read-char/special in config source))
92        (unless (char? next-c)
93          (unexpected-quoted next-c c))
94        (unless (or pipe-quote-c case-sens?)
95          (accum-string-convert! accum-str string-foldcase foldcase-from))
96        (accum-string-add! accum-str next-c)
97        (set! quoted-ever? #t)
98        (loop #f #f (accum-string-count accum-str))]
99       [else
100        ;; Everything else
101        (unless init-c (consume-char in c))
102        (accum-string-add! accum-str c)
103        (loop #f pipe-quote-c foldcase-from)]))
104
105    (define str (accum-string-get! accum-str config))
106
107    ;; Disallow "." as a symbol
108    (when (and (= 1 (string-length str))
109               (not quoted-ever?)
110               (char=? #\. (effective-char (string-ref str 0) config)))
111      (reader-error in config "illegal use of `.`"))
112
113    (define num
114      (and (or (eq? mode 'symbol-or-number)
115               (string? mode))
116           (not quoted-ever?)
117           (unchecked-string->number (if (string? mode)
118                                         (string-append mode str)
119                                         str)
120                                     10
121                                     'read
122                                     (if (check-parameter read-decimal-as-inexact config)
123                                         'decimal-as-inexact
124                                         'decimal-as-exact)
125                                     (if (check-parameter read-single-flonum config)
126                                         'single
127                                         'double))))
128    (when (string? num)
129      (reader-error in config "~a" num))
130
131    (when (and (not num)
132               (string? mode))
133      (reader-error in config
134                    "bad number: `~a`"
135                    (string-append mode str)))
136
137    (wrap (or num
138              (and (eq? mode 'keyword)
139                   (string->keyword str))
140              (string->symbol str))
141          in
142          config
143          str)]))
144