From 1936f5ec76d87e2b3c2d5deb1e166f49237bb17f Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Thu, 16 May 1991 16:03:39 +0000 Subject: [PATCH] Really fixed output type stuff this time. Now in the fall-through clauses, we call OUTPUT-TYPE-OR-LOSE, which uses SUBTYPEP, and guarantees to return one of LIST, STRING, BIT-VECTOR, VECTOR or NIL (the last enabled by an optional.) --- code/seq.lisp | 52 +++++++++++++++++++++++++++++++++------------------ 1 file changed, 34 insertions(+), 18 deletions(-) diff --git a/code/seq.lisp b/code/seq.lisp index 4988c8999..c1abc262a 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.7 1991/05/14 16:24:15 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/seq.lisp,v 1.8 1991/05/16 16:03:39 ram Exp $") ;;; ;;; ********************************************************************** ;;; @@ -60,6 +60,25 @@ + +;;; RESULT-TYPE-OR-LOSE -- Internal +;;; +;;; Given an arbitrary type specifier, return a sane sequence type specifier +;;; that we can directly match. +;;; +(defun result-type-or-lose (type &optional nil-ok) + (cond + ((subtypep type 'nil) + (if nil-ok + nil + (error "NIL output type invalid for this sequence function."))) + ((dolist (seq-type '(list bit-vector string vector) nil) + (when (subtypep type seq-type) + (return seq-type)))) + (t + (error "~S is a bad type specifier for sequence functions." type)))) + + (defun make-sequence-of-type (type length) "Returns a sequence of the given TYPE and LENGTH." (declare (fixnum length)) @@ -73,14 +92,9 @@ (if (listp type) (make-array length :element-type (cadr type)) (make-array length))) - ((bit-vector simple-bit-vector) - (make-array length :element-type '(mod 2))) (t - (let ((exp (type-expand type))) - (if (eq exp type) - (error "~S is a bad type specifier for sequence functions." type) - (make-sequence-of-type exp length)))))) - + (make-sequence-of-type (result-type-or-lose type) length)))) + (defun elt (sequence index) "Returns the element of SEQUENCE specified by INDEX." (etypecase sequence @@ -542,13 +556,14 @@ "Returns a new sequence of all the argument sequences concatenated together which shares no structure with the original argument sequences of the specified OUTPUT-TYPE-SPEC." - (let ((output-type-spec (type-expand output-type-spec))) - (case (type-specifier-atom output-type-spec) - (list (apply #'concat-to-list* sequences)) - ((simple-vector simple-string vector string array simple-array - bit-vector simple-bit-vector base-string simple-base-string) - (apply #'concat-to-simple* output-type-spec sequences)) - (t (error "~S: invalid output type specification." output-type-spec))))) + (case (type-specifier-atom output-type-spec) + ((simple-vector simple-string vector string array simple-array + bit-vector simple-bit-vector base-string + simple-base-string) + (apply #'concat-to-simple* output-type-spec sequences)) + (list (apply #'concat-to-list* sequences)) + (t + (apply #'concatenate (result-type-or-lose output-type-spec) sequences)))) ;;; Internal Frobs: @@ -618,15 +633,16 @@ "FUNCTION must take as many arguments as there are sequences provided. The result is a sequence such that element i is the result of applying FUNCTION to element i of each of the argument sequences." - (let ((sequences (cons first-sequence more-sequences)) - (output-type-spec (type-expand output-type-spec))) + (let ((sequences (cons first-sequence more-sequences))) (case (type-specifier-atom output-type-spec) ((nil) (map-for-effect function sequences)) (list (map-to-list function sequences)) ((simple-vector simple-string vector string array simple-array bit-vector simple-bit-vector base-string simple-base-string) (map-to-simple output-type-spec function sequences)) - (t (error "~S: invalid output type specifier." output-type-spec))))) + (t + (apply #'map (result-type-or-lose output-type-spec t) + function sequences))))) ;;; Quantifiers: -- GitLab