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