use-syntax ice-9 syncase define operator and member define separator a

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
(use-syntax (ice-9 syncase))
(define (operator? x)
(and (member x '(#\+ #\- #\/ #\*)) #t))
(define (separator? x)
(and (member x '(#\space #\tab #\newline)) #t))
(define (digit? x)
(and (<= 48 (char->integer x))
(>= 57 (char->integer x))))
(define-syntax ++
(syntax-rules ()
((_ i) (+ i 1))))
(define-syntax while
(syntax-rules ()
((while a expr ...)
(let loop ()
(if a (begin expr ... (loop)))))))
(define (check-integer string)
(let loop ((i 0))
(cond ((= i (string-length string)))
((or (and (= i 0) (> (string-length string) 1) (operator? (string-ref string i)))
(digit? (string-ref string i)))
(loop (++ i)))
(else #f))))
(define (scan-integer string)
(cond ((check-integer string) string)
(else #f)))
(define (scan-many-integers string)
(let loop ((i 0)
(start 0)
(res '()))
(cond ((= i (string-length string)) (make-numbers (reverse (cons (substring string start i) res))))
((separator? (string-ref string i)) (loop (++ i) (++ i) (if (not (= i start))
(cons (substring string start i) res)
res)))
((or (and (= i start) (operator? (string-ref string i)))
(digit? (string-ref string i)))
(loop (++ i) start res))
(else #f))))
(define (empty? xs)
(member (car xs) '("+" "-" "/" "*")))
(define (make-numbers xs)
(cond ((null? xs) '())
((empty? xs) #f)
(else (if (not (equal? (car xs) ""))
(cons (string->number (car xs)) (make-numbers (cdr xs)))
(make-numbers (cdr xs))))))