From ea2ed192057916db255b0d063655c80f0b017213 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sat, 11 Mar 2017 01:10:01 -0800 Subject: [PATCH] Speed up reading of #\x... characters. --- src/runtime/parse.scm | 41 ++++++++++++++++++++--------------------- 1 file changed, 20 insertions(+), 21 deletions(-) diff --git a/src/runtime/parse.scm b/src/runtime/parse.scm index 40d1148c4..168ebec73 100644 --- a/src/runtime/parse.scm +++ b/src/runtime/parse.scm @@ -733,27 +733,21 @@ USA. (define (handler:char db ctx char1 char2) ctx char1 char2 - (let ((char (%read-char/no-eof db)) - (at-end? - (lambda () - (let ((char (%peek-char db))) - (or (eof-object? char) - (atom-delimiter? char)))))) - (if (or (atom-delimiter? char) - (at-end?)) - char - (name->char - (let ((builder (string-builder))) - (builder char) - (let loop () - (builder (let ((char (%read-char/no-eof db))) - (if (char=? char #\\) - (%read-char/no-eof db) - char))) - (if (not (at-end?)) - (loop))) - (builder)) - (db-fold-case? db))))) + (let ((char (%read-char/no-eof db))) + (cond ((or (atom-delimiter? char) + (let ((char (%peek-char db))) + (or (eof-object? char) + (atom-delimiter? char)))) + char) + ((char-ci=? char #\x) + (let* ((string (parse-atom db '())) + (cp (string->number string 16 #t))) + (if (not (unicode-code-point? cp)) + (error:illegal-code-point string)) + (integer->char cp))) + (else + (name->char (parse-atom db (list char)) + (db-fold-case? db)))))) (define (handler:named-constant db ctx char1 char2) ctx char1 char2 @@ -1032,6 +1026,11 @@ USA. (cdr objects)))) (write-string "]" port))) +(define-parse-error (illegal-code-point string) + (lambda (string port) + (write-string "Ill-formed code point: " port) + (write string port))) + (define-parse-error (illegal-named-constant name) (lambda (name port) (write-string "Ill-formed named constant: #!" port) -- 2.25.1