From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Fri, 3 Nov 1995 21:24:01 +0000 (+0000)
Subject: Changed DIGIT->CHAR and CHAR->DIGIT to give better error messages and
X-Git-Tag: 20090517-FFI~5787
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=39250d0ee3bb9212b8a4080356f14b17a57a93eb;p=mit-scheme.git

Changed DIGIT->CHAR and CHAR->DIGIT to give better error messages and
to be faster.
---

diff --git a/v7/src/runtime/char.scm b/v7/src/runtime/char.scm
index c112f133f..5feb5b08b 100644
--- a/v7/src/runtime/char.scm
+++ b/v7/src/runtime/char.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/char.scm,v 14.3 1991/08/28 13:36:30 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/char.scm,v 14.4 1995/11/03 21:24:01 adams Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -192,28 +192,35 @@ MIT in each case. |#
   (loop alist))
 
 (define (digit->char digit #!optional radix)
-  (cond ((default-object? radix) (set! radix 10))
-	((not (and (<= 2 radix) (<= radix 36)))
-	 (error "DIGIT->CHAR: Bad radix" radix)))
-  (and (<= 0 digit) (< digit radix)
-       (code->char (if (< digit 10)
-		       (+ digit 0-code)
-		       (+ (- digit 10) upper-a-code)))))
+  (define exact-integer? fix:fixnum?)	; good enough
+  (let ((radix
+	 (cond ((default-object? radix) 10)
+	       ((and (exact-integer? radix) (<= 2 radix) (<= radix 36)) radix)
+	       (else (error:wrong-type-argument radix "Radix" 'DIGIT->CHAR)))))
+    (if (exact-integer? digit)
+	(and (<= 0 digit) (< digit radix)
+	     (string-ref "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" digit))
+	(error:wrong-type-argument digit "exact integer" 'DIGIT->CHAR))))
+
 
 (define (char->digit char #!optional radix)
-  (cond ((default-object? radix) (set! radix 10))
-	((not (and (<= 2 radix) (<= radix 36)))
-	 (error "CHAR->DIGIT: Bad radix" radix)))
-  (and (zero? (char-bits char))
-       (let ((code (char-code char)))
-	 (define (try base-digit base-code)
-	   (let ((n (+ base-digit (- code base-code))))
-	     (and (<= base-digit n)
-		  (< n radix)
-		  n)))
-	 (or (try 0 0-code)
-	     (try 10 upper-a-code)
-	     (try 10 lower-a-code)))))
+  (define exact-integer? fix:fixnum?)	; good enough
+  (let ((radix
+	 (cond ((default-object? radix)  10)
+	       ((and (exact-integer? radix) (<= 2 radix) (<= radix 36)) radix)
+	       (else (error:wrong-type-argument radix "Radix" 'CHAR->DIGIT)))))
+    (if (not (char? char))
+	(error:wrong-type-argument char "character" 'CHAR->DIGIT))
+    (and (zero? (char-bits char))
+	 (let ((code (char-code char)))
+	   (define (try base-digit base-code)
+	     (let ((n (fix:+ base-digit (fix:- code base-code))))
+	       (and (<= base-digit n)
+		    (< n radix)
+		    n)))
+	   (or (try 0 0-code)
+	       (try 10 upper-a-code)
+	       (try 10 lower-a-code))))))
 
 (define (name->char string)
   (let ((end (string-length string))