1#lang racket/base
2(require "config.rkt"
3         "special.rkt"
4         "consume.rkt"
5         "accum-string.rkt")
6
7(provide read-digits
8         digit?
9         decimal-digit?
10         octal-digit?
11         hex-digit?
12         digit->number)
13
14(define (read-digits in config [accum-str #f]
15                     #:base base #:max-count max-count
16                     #:init [init-v 0]
17                     #:zero-digits-result [zero-digits-result #f])
18  (define c (peek-char/special in config))
19  (cond
20   [(digit? c base)
21    (consume-char in c)
22    (when accum-str (accum-string-add! accum-str c))
23    (let loop ([v (+ (digit->number c) (* init-v base))]
24               [max-count (sub1 max-count)])
25      (cond
26       [(zero? max-count) v]
27       [else
28        (define c (peek-char/special in config))
29        (cond
30         [(digit? c base)
31          (consume-char in c)
32          (when accum-str (accum-string-add! accum-str c))
33          (loop (+ (digit->number c) (* v base)) (sub1 max-count))]
34         [else v])]))]
35   [zero-digits-result zero-digits-result]
36   [else c]))
37
38(define (digit? c base)
39  (cond
40   [(not (char? c)) #f]
41   [(= base 8) (octal-digit? c)]
42   [(= base 16) (hex-digit? c)]
43   [else (decimal-digit? c)]))
44
45(define (decimal-digit? c)
46  (and (char>=? c #\0) (char<=? c #\9)))
47
48(define (octal-digit? c)
49  (and (char>=? c #\0) (char<=? c #\7)))
50
51(define (hex-digit? c)
52  (or (and (char>=? c #\0) (char<=? c #\9))
53      (and (char>=? c #\A) (char<=? c #\F))
54      (and (char>=? c #\a) (char<=? c #\f))))
55
56(define (digit->number c)
57  (cond
58   [(and (char>=? c #\0) (char<=? c #\9))
59    (- (char->integer c) (char->integer #\0))]
60   [(and (char>=? c #\A) (char<=? c #\F))
61    (- (char->integer c) (- (char->integer #\A) 10))]
62   [else
63    (- (char->integer c) (- (char->integer #\a) 10))]))
64