X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fexternal-formats%2Fenc-iso.lisp;h=dba365b53295e70c8e7c2cf9fc52f7b51b2607c8;hb=8886298f2c0e50e595cf481c426b6331ab898a23;hp=0fb5cbe81bd3468a5aa0aecdcd742020adbfa2bf;hpb=42fcad110cd7e966c89bda8f5d3be96862ba1dbd;p=sbcl.git diff --git a/src/code/external-formats/enc-iso.lisp b/src/code/external-formats/enc-iso.lisp index 0fb5cbe..dba365b 100644 --- a/src/code/external-formats/enc-iso.lisp +++ b/src/code/external-formats/enc-iso.lisp @@ -63,14 +63,14 @@ (declaim (inline get-iso-8859-2-bytes)) (defun get-iso-8859-2-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-2 string pos end)) + (type simple-string string) + (type array-range pos end)) + (get-latin-bytes #'code->iso-8859-2-mapper :iso-8859-2 string pos end)) (defun string->iso-8859-2 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-iso-8859-2-bytes null-padding))) (defmacro define-iso-8859-2->string* (accessor type) @@ -78,22 +78,22 @@ (let ((name (make-od-name 'iso-8859-2->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-2->code-mapper))))) (instantiate-octets-definition define-iso-8859-2->string*) (defmacro define-iso-8859-2->string (accessor type) (declare (ignore type)) `(defun ,(make-od-name 'iso-8859-2->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-2->code-mapper))) (instantiate-octets-definition define-iso-8859-2->string) -(push '((:iso-8859-2 :|iso-8859-2|) +(push '((:iso-8859-2 :|iso-8859-2| :latin-2 :|latin-2|) iso-8859-2->string-aref string->iso-8859-2) *external-format-functions*) -(define-external-format (:iso-8859-2 :|iso-8859-2|) +(define-external-format (:iso-8859-2 :|iso-8859-2| :latin-2 :|latin-2|) 1 t (let ((iso-8859-2-byte (code->iso-8859-2-mapper bits))) (if iso-8859-2-byte @@ -145,14 +145,14 @@ (declaim (inline get-iso-8859-3-bytes)) (defun get-iso-8859-3-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-3 string pos end)) + (type simple-string string) + (type array-range pos end)) + (get-latin-bytes #'code->iso-8859-3-mapper :iso-8859-3 string pos end)) (defun string->iso-8859-3 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-iso-8859-3-bytes null-padding))) (defmacro define-iso-8859-3->string* (accessor type) @@ -160,22 +160,22 @@ (let ((name (make-od-name 'iso-8859-3->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-3->code-mapper))))) (instantiate-octets-definition define-iso-8859-3->string*) (defmacro define-iso-8859-3->string (accessor type) (declare (ignore type)) `(defun ,(make-od-name 'iso-8859-3->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-3->code-mapper))) (instantiate-octets-definition define-iso-8859-3->string) -(push '((:iso-8859-3 :|iso-8859-3|) +(push '((:iso-8859-3 :|iso-8859-3| :latin-3 :|latin-3|) iso-8859-3->string-aref string->iso-8859-3) *external-format-functions*) -(define-external-format (:iso-8859-3 :|iso-8859-3|) +(define-external-format (:iso-8859-3 :|iso-8859-3| :latin-3 :|latin-3|) 1 t (let ((iso-8859-3-byte (code->iso-8859-3-mapper bits))) (if iso-8859-3-byte @@ -242,14 +242,14 @@ (declaim (inline get-iso-8859-4-bytes)) (defun get-iso-8859-4-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-4 string pos end)) + (type simple-string string) + (type array-range pos end)) + (get-latin-bytes #'code->iso-8859-4-mapper :iso-8859-4 string pos end)) (defun string->iso-8859-4 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-iso-8859-4-bytes null-padding))) (defmacro define-iso-8859-4->string* (accessor type) @@ -257,22 +257,22 @@ (let ((name (make-od-name 'iso-8859-4->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-4->code-mapper))))) (instantiate-octets-definition define-iso-8859-4->string*) (defmacro define-iso-8859-4->string (accessor type) (declare (ignore type)) `(defun ,(make-od-name 'iso-8859-4->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-4->code-mapper))) (instantiate-octets-definition define-iso-8859-4->string) -(push '((:iso-8859-4 :|iso-8859-4|) +(push '((:iso-8859-4 :|iso-8859-4| :latin-4 :|latin-4|) iso-8859-4->string-aref string->iso-8859-4) *external-format-functions*) -(define-external-format (:iso-8859-4 :|iso-8859-4|) +(define-external-format (:iso-8859-4 :|iso-8859-4| :latin-4 :|latin-4|) 1 t (let ((iso-8859-4-byte (code->iso-8859-4-mapper bits))) (if iso-8859-4-byte @@ -383,14 +383,14 @@ (declaim (inline get-iso-8859-5-bytes)) (defun get-iso-8859-5-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-5 string pos end)) + (type simple-string string) + (type array-range pos end)) + (get-latin-bytes #'code->iso-8859-5-mapper :iso-8859-5 string pos end)) (defun string->iso-8859-5 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-iso-8859-5-bytes null-padding))) (defmacro define-iso-8859-5->string* (accessor type) @@ -398,14 +398,14 @@ (let ((name (make-od-name 'iso-8859-5->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-5->code-mapper))))) (instantiate-octets-definition define-iso-8859-5->string*) (defmacro define-iso-8859-5->string (accessor type) (declare (ignore type)) `(defun ,(make-od-name 'iso-8859-5->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-5->code-mapper))) (instantiate-octets-definition define-iso-8859-5->string) @@ -523,14 +523,14 @@ (declaim (inline get-iso-8859-6-bytes)) (defun get-iso-8859-6-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-6 string pos end)) + (type simple-string string) + (type array-range pos end)) + (get-latin-bytes #'code->iso-8859-6-mapper :iso-8859-6 string pos end)) (defun string->iso-8859-6 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-iso-8859-6-bytes null-padding))) (defmacro define-iso-8859-6->string* (accessor type) @@ -538,14 +538,14 @@ (let ((name (make-od-name 'iso-8859-6->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-6->code-mapper))))) (instantiate-octets-definition define-iso-8859-6->string*) (defmacro define-iso-8859-6->string (accessor type) (declare (ignore type)) `(defun ,(make-od-name 'iso-8859-6->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-6->code-mapper))) (instantiate-octets-definition define-iso-8859-6->string) @@ -650,14 +650,14 @@ (declaim (inline get-iso-8859-7-bytes)) (defun get-iso-8859-7-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-7 string pos end)) + (type simple-string string) + (type array-range pos end)) + (get-latin-bytes #'code->iso-8859-7-mapper :iso-8859-7 string pos end)) (defun string->iso-8859-7 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-iso-8859-7-bytes null-padding))) (defmacro define-iso-8859-7->string* (accessor type) @@ -665,14 +665,14 @@ (let ((name (make-od-name 'iso-8859-7->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-7->code-mapper))))) (instantiate-octets-definition define-iso-8859-7->string*) (defmacro define-iso-8859-7->string (accessor type) (declare (ignore type)) `(defun ,(make-od-name 'iso-8859-7->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-7->code-mapper))) (instantiate-octets-definition define-iso-8859-7->string) @@ -766,14 +766,14 @@ (declaim (inline get-iso-8859-8-bytes)) (defun get-iso-8859-8-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-8 string pos end)) + (type simple-string string) + (type array-range pos end)) + (get-latin-bytes #'code->iso-8859-8-mapper :iso-8859-8 string pos end)) (defun string->iso-8859-8 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-iso-8859-8-bytes null-padding))) (defmacro define-iso-8859-8->string* (accessor type) @@ -781,14 +781,14 @@ (let ((name (make-od-name 'iso-8859-8->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-8->code-mapper))))) (instantiate-octets-definition define-iso-8859-8->string*) (defmacro define-iso-8859-8->string (accessor type) (declare (ignore type)) `(defun ,(make-od-name 'iso-8859-8->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-8->code-mapper))) (instantiate-octets-definition define-iso-8859-8->string) @@ -819,14 +819,14 @@ (declaim (inline get-iso-8859-9-bytes)) (defun get-iso-8859-9-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-9 string pos end)) + (type simple-string string) + (type array-range pos end)) + (get-latin-bytes #'code->iso-8859-9-mapper :iso-8859-9 string pos end)) (defun string->iso-8859-9 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-iso-8859-9-bytes null-padding))) (defmacro define-iso-8859-9->string* (accessor type) @@ -834,22 +834,22 @@ (let ((name (make-od-name 'iso-8859-9->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-9->code-mapper))))) (instantiate-octets-definition define-iso-8859-9->string*) (defmacro define-iso-8859-9->string (accessor type) (declare (ignore type)) `(defun ,(make-od-name 'iso-8859-9->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-9->code-mapper))) (instantiate-octets-definition define-iso-8859-9->string) -(push '((:iso-8859-9 :|iso-8859-9|) +(push '((:iso-8859-9 :|iso-8859-9| :latin-5 :|latin-5|) iso-8859-9->string-aref string->iso-8859-9) *external-format-functions*) -(define-external-format (:iso-8859-9 :|iso-8859-9|) +(define-external-format (:iso-8859-9 :|iso-8859-9| :latin-5 :|latin-5|) 1 t (let ((iso-8859-9-byte (code->iso-8859-9-mapper bits))) (if iso-8859-9-byte @@ -912,14 +912,14 @@ (declaim (inline get-iso-8859-10-bytes)) (defun get-iso-8859-10-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-10 string pos end)) + (type simple-string string) + (type array-range pos end)) + (get-latin-bytes #'code->iso-8859-10-mapper :iso-8859-10 string pos end)) (defun string->iso-8859-10 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-iso-8859-10-bytes null-padding))) (defmacro define-iso-8859-10->string* (accessor type) @@ -927,22 +927,22 @@ (let ((name (make-od-name 'iso-8859-10->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-10->code-mapper))))) (instantiate-octets-definition define-iso-8859-10->string*) (defmacro define-iso-8859-10->string (accessor type) (declare (ignore type)) `(defun ,(make-od-name 'iso-8859-10->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-10->code-mapper))) (instantiate-octets-definition define-iso-8859-10->string) -(push '((:iso-8859-10 :|iso-8859-10|) +(push '((:iso-8859-10 :|iso-8859-10| :latin-6 :|latin-6|) iso-8859-10->string-aref string->iso-8859-10) *external-format-functions*) -(define-external-format (:iso-8859-10 :|iso-8859-10|) +(define-external-format (:iso-8859-10 :|iso-8859-10| :latin-6 :|latin-6|) 1 t (let ((iso-8859-10-byte (code->iso-8859-10-mapper bits))) (if iso-8859-10-byte @@ -1054,14 +1054,14 @@ (declaim (inline get-iso-8859-11-bytes)) (defun get-iso-8859-11-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-11 string pos end)) + (type simple-string string) + (type array-range pos end)) + (get-latin-bytes #'code->iso-8859-11-mapper :iso-8859-11 string pos end)) (defun string->iso-8859-11 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-iso-8859-11-bytes null-padding))) (defmacro define-iso-8859-11->string* (accessor type) @@ -1069,14 +1069,14 @@ (let ((name (make-od-name 'iso-8859-11->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-11->code-mapper))))) (instantiate-octets-definition define-iso-8859-11->string*) (defmacro define-iso-8859-11->string (accessor type) (declare (ignore type)) `(defun ,(make-od-name 'iso-8859-11->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-11->code-mapper))) (instantiate-octets-definition define-iso-8859-11->string) @@ -1157,14 +1157,14 @@ (declaim (inline get-iso-8859-13-bytes)) (defun get-iso-8859-13-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-13 string pos end)) + (type simple-string string) + (type array-range pos end)) + (get-latin-bytes #'code->iso-8859-13-mapper :iso-8859-13 string pos end)) (defun string->iso-8859-13 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-iso-8859-13-bytes null-padding))) (defmacro define-iso-8859-13->string* (accessor type) @@ -1172,22 +1172,22 @@ (let ((name (make-od-name 'iso-8859-13->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-13->code-mapper))))) (instantiate-octets-definition define-iso-8859-13->string*) (defmacro define-iso-8859-13->string (accessor type) (declare (ignore type)) `(defun ,(make-od-name 'iso-8859-13->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-13->code-mapper))) (instantiate-octets-definition define-iso-8859-13->string) -(push '((:iso-8859-13 :|iso-8859-13|) +(push '((:iso-8859-13 :|iso-8859-13| :latin-7 :|latin-7|) iso-8859-13->string-aref string->iso-8859-13) *external-format-functions*) -(define-external-format (:iso-8859-13 :|iso-8859-13|) +(define-external-format (:iso-8859-13 :|iso-8859-13| :latin-7 :|latin-7|) 1 t (let ((iso-8859-13-byte (code->iso-8859-13-mapper bits))) (if iso-8859-13-byte @@ -1235,14 +1235,14 @@ (declaim (inline get-iso-8859-14-bytes)) (defun get-iso-8859-14-bytes(string pos end) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range pos end)) - (get-latin-bytes #'identity :iso-8859-14 string pos end)) + (type simple-string string) + (type array-range pos end)) + (get-latin-bytes #'code->iso-8859-14-mapper :iso-8859-14 string pos end)) (defun string->iso-8859-14 (string sstart send null-padding) (declare (optimize speed (safety 0)) - (type simple-string string) - (type array-range sstart send)) + (type simple-string string) + (type array-range sstart send)) (values (string->latin% string sstart send #'get-iso-8859-14-bytes null-padding))) (defmacro define-iso-8859-14->string* (accessor type) @@ -1250,22 +1250,22 @@ (let ((name (make-od-name 'iso-8859-14->string* accessor))) `(progn (defun ,name (string sstart send array astart aend) - (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity))))) + (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-14->code-mapper))))) (instantiate-octets-definition define-iso-8859-14->string*) (defmacro define-iso-8859-14->string (accessor type) (declare (ignore type)) `(defun ,(make-od-name 'iso-8859-14->string accessor) (array astart aend) - (,(make-od-name 'latin->string accessor) array astart aend #'identity))) + (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-14->code-mapper))) (instantiate-octets-definition define-iso-8859-14->string) -(push '((:iso-8859-14 :|iso-8859-14|) +(push '((:iso-8859-14 :|iso-8859-14| :latin-8 :|latin-8|) iso-8859-14->string-aref string->iso-8859-14) *external-format-functions*) -(define-external-format (:iso-8859-14 :|iso-8859-14|) +(define-external-format (:iso-8859-14 :|iso-8859-14| :latin-8 :|latin-8|) 1 t (let ((iso-8859-14-byte (code->iso-8859-14-mapper bits))) (if iso-8859-14-byte