(define char-miscellaneous? (lambda (char) (member char '(#\< #\> #\~ #\! #\$ #\% #\^ #\& #\+ #\* #\/ #\= #\_ #\?)))) (define char-legal-first? (lambda (char) (or (char-alphabetic? char) (char-miscellaneous? char)))) (define char-symbolic? (lambda (char) (or (char-legal-first? char) (char-numeric? char)))) (define eat-c (lambda (pred) (letrec ((loop (lambda (str acc) (if (null? str) (list acc ()) (let ((char (car str))) (if (not (pred char)) (list acc str) (loop (cdr str) (append acc (list char))))))))) loop))) (define eat-number (lambda (str) (let ((x ((eat-c char-numeric?) str ()))) (list (string->number (apply string (car x))) (cadr x))))) (define eat-symbol (lambda (str) (let ((x ((eat-c char-symbolic?) str ()))) (list (string->symbol (apply string (car x))) (cadr x))))) (define scan (lambda (ls) (if (null? ls) () (let ((char (car ls))) (cond ((eq? char #\space) (scan (cdr ls))) ((member char '(#\( #\) #\. #\')) (cons char (scan (cdr ls)))) ((char-numeric? char) (let ((x (eat-number ls))) (cons (car x) (scan (cadr x))))) ((eq? char #\-) (let ((x (cdr ls))) (if (not (null? x)) (cond ((char-numeric? (car x)) (let ((y (eat-number x))) (cons (- (car y)) (scan (cadr y))))) ((char-symbolic? (car x)) (let ((y (eat-symbol x))) (cons (car y) (scan (cadr y))))) (else (cons '- (scan x)))) '-))) ((char-legal-first? char) (let ((x (eat-symbol ls))) (cons (car x) (scan (cadr x))))) (else (error "illegal character.")))))))