X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Foctets.lisp;h=4a98d8082a196b82f16d4ab4090438a1a54ca0df;hb=a6a12ed609d5467ec43b411283e5b3568fee81df;hp=0d155f15d583453424f0dad408babec1af6551db;hpb=7cf58295cc5e1ca50651c4b93023ae8681fed8fb;p=sbcl.git diff --git a/src/code/octets.lisp b/src/code/octets.lisp index 0d155f1..4a98d80 100644 --- a/src/code/octets.lisp +++ b/src/code/octets.lisp @@ -38,12 +38,6 @@ one-past-the-end" (octets-encoding-error-position c))) (octets-encoding-error-external-format c))))) -(defun read-replacement-character () - (format *query-io* - "Replacement byte, bytes, character, or string (evaluated): ") - (finish-output *query-io*) - (list (eval (read *query-io*)))) - (defun encoding-error (external-format string pos) (restart-case (error 'octets-encoding-error @@ -52,7 +46,10 @@ one-past-the-end" :position pos) (use-value (replacement) :report "Supply a set of bytes to use in place of the invalid one." - :interactive read-replacement-character + :interactive + (lambda () + (read-evaluated-form + "Replacement byte, bytes, character, or string (evaluated): ")) (typecase replacement ((unsigned-byte 8) (make-array 1 :element-type '(unsigned-byte 8) :initial-element replacement)) @@ -103,11 +100,6 @@ one-past-the-end" (define-condition malformed-ascii (octet-decoding-error) ()) -(defun read-replacement-string () - (format *query-io* "Enter a replacement string designator (evaluated): ") - (finish-output *query-io*) - (list (eval (read *query-io*)))) - (defun decoding-error (array start end external-format reason pos) (restart-case (error reason @@ -118,7 +110,10 @@ one-past-the-end" :pos pos) (use-value (s) :report "Supply a replacement string designator." - :interactive read-replacement-string + :interactive + (lambda () + (read-evaluated-form + "Enter a replacement string designator (evaluated): ")) (string s)))) ;;; Utilities used in both to-string and to-octet conversions @@ -183,9 +178,8 @@ one-past-the-end" finally (return elements))) ;; Find the smallest character code such that the corresponding ;; byte is != to the code. - (lowest-non-equivalent-code (position-if-not #'(lambda (pair) - (apply #'= pair)) - pairs)) + (lowest-non-equivalent-code + (caar (sort (copy-seq exceptions) #'< :key #'car))) ;; Sort them for our lookup table. (sorted-pairs (sort (subseq pairs lowest-non-equivalent-code) #'< :key #'car)) @@ -199,9 +193,9 @@ one-past-the-end" ,(make-array 256 :element-type t #+nil 'char-code :initial-contents (loop for byte below 256 collect - (let ((exception (cadr (assoc byte exceptions)))) + (let ((exception (cdr (assoc byte exceptions)))) (if exception - exception + (car exception) byte))))) (code-to-byte-table ,(make-array (length sorted-lookup-table) @@ -392,8 +386,7 @@ one-past-the-end" :check-fill-pointer t) (declare (type (simple-array (unsigned-byte 8) (*)) vector)) (let ((ef (maybe-defaulted-external-format external-format))) - (funcall (symbol-function (sb!impl::ef-octets-to-string-sym ef)) - vector start end)))) + (funcall (sb!impl::ef-octets-to-string-fun ef) vector start end)))) (defun string-to-octets (string &key (external-format :default) (start 0) end null-terminate) @@ -404,8 +397,8 @@ one-past-the-end" :check-fill-pointer t) (declare (type simple-string string)) (let ((ef (maybe-defaulted-external-format external-format))) - (funcall (symbol-function (sb!impl::ef-string-to-octets-sym ef)) - string start end (if null-terminate 1 0))))) + (funcall (sb!impl::ef-string-to-octets-fun ef) string start end + (if null-terminate 1 0))))) #!+sb-unicode (defvar +unicode-replacement-character+ (string (code-char #xfffd)))