Avoid type check for classes

clasp-developers · Sep 6, 2024 · a07daeb · a07daeb
1 parent 0acf490
commit a07daeb
Show file tree

Hide file tree

Showing 2 changed files with 17 additions and 14 deletions.
diff --git a/src/lisp/kernel/cmp/opt/opt-sequence.lisp b/src/lisp/kernel/cmp/opt/opt-sequence.lisp
@@ -167,20 +167,22 @@
                      ;; types we kind of just give up.
                      ;; MAKE-SEQUENCE handles any length check.
                      ;; TODO: Call SEQUENCE:MAP for user sequence types, maybe.
-                     (let ((ssyms (gensym-list sequences "SEQUENCE"))
-                           (result (gensym "RESULT")))
+                     (let* ((ssyms (gensym-list sequences "SEQUENCE"))
+                            (result (gensym "RESULT"))
+                            (result-form `(core::map-into-sequence
+                                           (make-sequence ',type
+                                                          (min ,@(loop for ssym in ssyms
+                                                                       collect `(length ,ssym))))
+                                           ,function ,@ssyms)))
                        `(let (,@(mapcar #'list ssyms sequences))
-                          (let ((,result
-                                  (core::map-into-sequence
-                                   (make-sequence ',type
-                                                  (min ,@(loop for ssym in ssyms
-                                                               collect `(length ,ssym))))
-                                   ,function ,@ssyms)))
-                            (if (typep ,result ',type)
-                                ,result
-                                (error 'type-error
-                                       :datum ,result
-                                       :expected-type ',type))))))))))
+                          ,(if (consp type)
+                               `(let ((,result ,result-form))
+                                  (if (typep ,result ',type)
+                                      ,result
+                                      (error 'type-error
+                                             :datum ,result
+                                             :expected-type ',type)))
+                               result-form))))))))
       form))
 
 ;;;

diff --git a/src/lisp/kernel/lsp/seq.lisp b/src/lisp/kernel/lsp/seq.lisp
@@ -442,7 +442,8 @@ SEQUENCEs, where K is the minimum length of the given SEQUENCEs."
                                                     :initial-value (length sequence)
                                                     :key #'length))
                              function sequence more-sequences)))
-                (if (typep result result-type)
+                (if (or (not (consp result-type))
+                        (typep result result-type))
                     result
                     (error 'type-error
                            :datum result