diff --git a/code/seq.lisp b/code/seq.lisp index aa4b6bb590cfdf94802bd9b173d4584cb61cb0e3..250a86a3e6e364a1241029836946ea7280fe47b5 100644 --- a/code/seq.lisp +++ b/code/seq.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/seq.lisp,v 1.15 1993/11/02 16:12:54 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/seq.lisp,v 1.16 1994/02/04 15:25:43 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -798,82 +798,85 @@ (defun coerce (object output-type-spec) "Coerces the Object to an object of type Output-Type-Spec." - (cond - ((typep object output-type-spec) - object) - ((eq output-type-spec 'character) - (character object)) - ((eq output-type-spec 'function) - (eval `#',object)) - ((numberp object) - (case output-type-spec - ((short-float single-float float) - (%single-float object)) - ((double-float long-float) - (%double-float object)) - (complex - (complex object)) - (t - (error "~S can't be converted to type ~S." object output-type-spec)))) - (t - (typecase object - (list - (case (type-specifier-atom output-type-spec) - ((simple-string string simple-base-string base-string) - (list-to-string* object)) - ((simple-bit-vector bit-vector) (list-to-bit-vector* object)) - ((simple-vector vector array simple-array) - (list-to-vector* object output-type-spec)) - (t (error "Can't coerce ~S to type ~S." object output-type-spec)))) - (simple-string - (case (type-specifier-atom output-type-spec) - (list (vector-to-list* object)) - ;; Can't coerce a string to a bit-vector! - ((simple-vector vector array simple-array) - (vector-to-vector* object output-type-spec)) - (t (error "Can't coerce ~S to type ~S." object output-type-spec)))) - (simple-bit-vector - (case (type-specifier-atom output-type-spec) - (list (vector-to-list* object)) - ;; Can't coerce a bit-vector to a string! - ((simple-vector vector array simple-array) - (vector-to-vector* object output-type-spec)) - (t (error "Can't coerce ~S to type ~S." object output-type-spec)))) - (simple-vector - (case (type-specifier-atom output-type-spec) - (list (vector-to-list* object)) - ((simple-string string simple-base-string base-string) + (let ((output-type-spec (type-expand output-type-spec))) + (cond + ((typep object output-type-spec) + object) + ((eq output-type-spec 'character) + (character object)) + ((eq output-type-spec 'function) + (eval `#',object)) + ((numberp object) + (case output-type-spec + ((short-float single-float float) + (%single-float object)) + ((double-float long-float) + (%double-float object)) + (complex + (complex object)) + (t + (error "~S can't be converted to type ~S." object output-type-spec)))) + (t + (typecase object + (list + (case (type-specifier-atom output-type-spec) + ((simple-string string simple-base-string base-string) + (list-to-string* object)) + ((simple-bit-vector bit-vector) (list-to-bit-vector* object)) + ((simple-vector vector array simple-array) + (list-to-vector* object output-type-spec)) + (t (error "Can't coerce ~S to type ~S." object output-type-spec)))) + (simple-string + (case (type-specifier-atom output-type-spec) + (list (vector-to-list* object)) + ;; Can't coerce a string to a bit-vector! + ((simple-vector vector array simple-array) + (vector-to-vector* object output-type-spec)) + (t (error "Can't coerce ~S to type ~S." object output-type-spec)))) + (simple-bit-vector + (case (type-specifier-atom output-type-spec) + (list (vector-to-list* object)) + ;; Can't coerce a bit-vector to a string! + ((simple-vector vector array simple-array) + (vector-to-vector* object output-type-spec)) + (t (error "Can't coerce ~S to type ~S." object output-type-spec)))) + (simple-vector + (case (type-specifier-atom output-type-spec) + (list (vector-to-list* object)) + ((simple-string string simple-base-string base-string) (vector-to-string* object)) - ((simple-bit-vector bit-vector) (vector-to-bit-vector* object)) - ((vector array simple-array) (vector-to-vector* object output-type-spec)) - (t (error "Can't coerce ~S to type ~S." object output-type-spec)))) - (string - (case (type-specifier-atom output-type-spec) - (list (vector-to-list* object)) - ((simple-string simple-base-string) - (string-to-simple-string* object)) - ;; Can't coerce a string to a bit-vector! - ((simple-vector vector simple-array array) - (vector-to-vector* object output-type-spec)) - (t (error "Can't coerce ~S to type ~S." object output-type-spec)))) - (bit-vector - (case (type-specifier-atom output-type-spec) - (list (vector-to-list* object)) - ;; Can't coerce a bit-vector to a string! - (simple-bit-vector (bit-vector-to-simple-bit-vector* object)) - ((simple-vector vector array simple-array) - (vector-to-vector* object output-type-spec)) - (t (error "Can't coerce ~S to type ~S." object output-type-spec)))) - (vector - (case (type-specifier-atom output-type-spec) - (list (vector-to-list* object)) - ((simple-string string base-string simple-base-string) - (vector-to-string* object)) - ((simple-bit-vector bit-vector) (vector-to-bit-vector* object)) - ((simple-vector vector array simple-array) - (vector-to-vector* object output-type-spec)) - (t (error "Can't coerce ~S to type ~S." object output-type-spec)))) - (t (error "~S is an inappropriate type of object for coerce." object)))))) + ((simple-bit-vector bit-vector) (vector-to-bit-vector* object)) + ((vector array simple-array) + (vector-to-vector* object output-type-spec)) + (t (error "Can't coerce ~S to type ~S." object output-type-spec)))) + (string + (case (type-specifier-atom output-type-spec) + (list (vector-to-list* object)) + ((simple-string simple-base-string) + (string-to-simple-string* object)) + ;; Can't coerce a string to a bit-vector! + ((simple-vector vector simple-array array) + (vector-to-vector* object output-type-spec)) + (t (error "Can't coerce ~S to type ~S." object output-type-spec)))) + (bit-vector + (case (type-specifier-atom output-type-spec) + (list (vector-to-list* object)) + ;; Can't coerce a bit-vector to a string! + (simple-bit-vector (bit-vector-to-simple-bit-vector* object)) + ((simple-vector vector array simple-array) + (vector-to-vector* object output-type-spec)) + (t (error "Can't coerce ~S to type ~S." object output-type-spec)))) + (vector + (case (type-specifier-atom output-type-spec) + (list (vector-to-list* object)) + ((simple-string string base-string simple-base-string) + (vector-to-string* object)) + ((simple-bit-vector bit-vector) (vector-to-bit-vector* object)) + ((simple-vector vector array simple-array) + (vector-to-vector* object output-type-spec)) + (t (error "Can't coerce ~S to type ~S." object output-type-spec)))) + (t + (error "~S is an inappropriate type of object for coerce." object))))))) ;;; Internal Frobs: