From 39250d0ee3bb9212b8a4080356f14b17a57a93eb Mon Sep 17 00:00:00 2001 From: Stephen Adams Date: Fri, 3 Nov 1995 21:24:01 +0000 Subject: [PATCH] Changed DIGIT->CHAR and CHAR->DIGIT to give better error messages and to be faster. --- v7/src/runtime/char.scm | 49 +++++++++++++++++++++++------------------ 1 file changed, 28 insertions(+), 21 deletions(-) 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)) -- 2.25.1