;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                         ;;;
;;;               Appendix E (Supplement) PC Scheme Version 3.03            ;;;
;;;                                                                         ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; These procedures are defined in the IEEE Scheme standard, but are not
;;; part of PC-Scheme.  If you wish to avoid overriding the built-in
;;; definition of string->symbol, then cook-identifier should be redefined
;;; so that instead of invoking string->symbol, it merely does the
;;; work of the case-insensitive string->symbol below.  Instead of redefining
;;; cook-identifier, string->symbol can be redefined using define-integrable,
;;; allowing Appendix E to remain unchanged.  In this case, the new
;;; integrable definition of string->symbol must exist before cook-identifier
;;; is defined.

(define-integrable string->symbol
  (lambda (s)
    (implode (map char-upcase (string->list s)))))

(define string
  (lambda args
    (list->string args)))

(define char-whitespace?
  (lambda (c)
    (and (char? c)
      (or (char=? c #\space) (char=? c #\tab) (char=? c #\return)
	  (char=? c #\newline) (char=? c #\page)))))

(define char-alphabetic?
  (lambda (c)
    (and (char? c)
      (or (and (char>=? c #\a) (char<=? c #\z))
          (and (char>=? c #\A) (char<=? c #\Z))))))

(define char-numeric?
  (lambda (c)
    (and (char? c) (char>=? c #\0) (char<=? c #\9))))

(define string->number
  (let ((char->digit
	  (lambda (c)
	    (if (char-numeric? c)
  	        (- (char->integer c) (char->integer #\0))
	        (error "Not a numeric character:" c)))))
    (lambda (s)
      (let ((len (string-length s)))
	(cond
	  ((zero? len) (error "String should not be empty:" s))
	  ((= len 1) (char->digit (string-ref s 0)))
	  (else (+ (char->digit (string-ref s (- len 1)))
		   (letrec
		     ((loop
		        (lambda (i times-ten)
			  (cond
			    ((zero? i) 0)
			    (else (+ (* (char->digit (string-ref s (- i 1)))
				        times-ten)
				     (loop (- i 1) (* 10 times-ten))))))))
		     (loop (- len 1) 10)))))))))