From 0dee0823994e653f075cb0387319bc3d1c320708 Mon Sep 17 00:00:00 2001 From: toy <toy> Date: Tue, 19 Nov 2002 14:39:50 +0000 Subject: [PATCH] MAKE-SEQUENCE checks the length is compatible for the types 'NULL and 'CONS. --- code/seq.lisp | 45 +++++++++++++++++++++++++++++++++++++-------- 1 file changed, 37 insertions(+), 8 deletions(-) diff --git a/code/seq.lisp b/code/seq.lisp index 413d9fa82..f556756c4 100644 --- a/code/seq.lisp +++ b/code/seq.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/seq.lisp,v 1.41 2002/11/13 19:47:18 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/seq.lisp,v 1.42 2002/11/19 14:39:50 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -173,22 +173,51 @@ (= type-len length))) ;; Type system not ready, so assume it's ok. t)) + +(defun bad-sequence-type-error (type-spec) + (error 'simple-type-error + :datum type-spec + ;; This expected-type is wrong; it should be something like + ;; (SATISFIES IS-A-VALID-SEQUENCE-TYPE-SPECIFIER-P), but we + ;; aren't really using it. + :expected-type 'sequence + :format-control "~S is a bad type specifier for sequences" + :format-arguments (list type-spec))) + +(defun sequence-length-error (type-spec length) + (error 'simple-type-error + :datum length + :expected-type (cond ((array-type-p type-spec) + `(eql ,(car (array-type-dimensions type-spec)))) + ((type= type-spec (specifier-type 'null)) + '(eql 0)) + ((cons-type-p type-spec) + `(integer 1)) + (t + (error "Shouldn't happen! Weird type"))) + :format-control "The length of ~S does not match the specified ~ + length of ~S." + :format-arguments (list (type-specifier type-spec) length))) (defun make-sequence (type length &key (initial-element NIL iep)) "Returns a sequence of the given Type and Length, with elements initialized to :Initial-Element." (declare (fixnum length)) (flet ((check-seq-len (spec-type length) - (unless (valid-sequence-and-length-p spec-type length) - (error 'simple-type-error - :format-control - "The length of ~S does not match the specified ~ - length of ~S." - :format-arguments - (list (type-specifier spec-type) length))))) + (unless (valid-sequence-and-length-p spec-type length) + (sequence-length-error spec-type length)))) (let ((type (specifier-type type))) (cond + ((csubtypep type (specifier-type 'null)) + (unless (zerop length) + (sequence-length-error type length)) + nil) + ((type= type (specifier-type 'cons)) + (unless (plusp length) + (sequence-length-error type length)) + (make-list length :initial-element initial-element)) + ;; Should we also check for types like '(cons (cons ...))? ((csubtypep type (specifier-type 'list)) (make-list length :initial-element initial-element)) ((csubtypep type (specifier-type 'string)) -- GitLab