Commit e8616faa authored by wlott's avatar wlott
Browse files

Fixed coerce to use subtypep to analyze the output type spec instead of

checking for magic symbols.
parent 51987841
......@@ -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.17 1994/02/05 11:41:36 ram Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/seq.lisp,v 1.18 1994/02/10 22:39:13 wlott Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -798,85 +798,51 @@
(defun coerce (object output-type-spec)
"Coerces the Object to an object of type Output-Type-Spec."
(let ((output-type-spec (type-expand output-type-spec)))
(let ((type (specifier-type output-type-spec)))
(cond
((typep object output-type-spec)
((%typep object output-type-spec)
object)
((eq output-type-spec 'character)
((csubtypep type (specifier-type 'character))
(character object))
((eq output-type-spec 'function)
((csubtypep type (specifier-type 'function))
(eval `#',object))
((numberp object)
(cond
((subtypep output-type-spec 'single-float)
((csubtypep type (specifier-type 'single-float))
(%single-float object))
((subtypep output-type-spec 'double-float)
((csubtypep type (specifier-type 'double-float))
(%double-float object))
((subtypep output-type-spec 'complex)
((csubtypep type (specifier-type 'complex))
(complex object))
(t
(error "~S can't be converted to type ~S." object output-type-spec))))
(t
(error "~S can't be converted to type ~S."
object output-type-spec))))
((csubtypep type (specifier-type 'list))
(if (vectorp object)
(vector-to-list* object)
(error "~S can't be converted to type ~S."
object output-type-spec)))
((csubtypep type (specifier-type 'string))
(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)))))))
(list (list-to-string* object))
(string (string-to-simple-string* object))
(vector (vector-to-string* object))
(t
(error "~S can't be converted to type ~S." object output-type-spec))))
((csubtypep type (specifier-type 'bit-vector))
(typecase object
(list (list-to-bit-vector* object))
(vector (vector-to-bit-vector* object))
(t
(error "~S can't be converted to type ~S." object output-type-spec))))
((csubtypep type (specifier-type 'vector))
(typecase object
(list (list-to-vector* object output-type-spec))
(vector (vector-to-vector* object output-type-spec))
(t
(error "~S can't be converted to type ~S." object output-type-spec))))
(t
(error "~S can't be converted to type ~S." object output-type-spec)))))
;;; Internal Frobs:
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment