Avoid constructing sequence-3 objects.

diff --git a/src/runtime/scan.scm b/src/runtime/scan.scm
index 595e733d429c07320a2a8b0b4a444c779ca6e1be..74334c6ad63726315cc63bdf84b9250a6c86247b 100644 (file)
--- a/src/runtime/scan.scm
+++ b/src/runtime/scan.scm
@@ -57,15 +57,9 @@ USA.
   '(NULL-SEQUENCE))
 
 (define (cons-sequence action seq)
-  (cond ((object-type? sequence-2-type seq)
-        (&typed-triple-cons sequence-3-type
-                            action
-                            (&pair-car seq)
-                            (&pair-cdr seq)))
-       ((eq? seq null-sequence)
-        action)
-       (else
-        (&typed-pair-cons sequence-2-type action seq))))
+  (if (eq? seq null-sequence)
+      action
+      (&typed-pair-cons sequence-2-type action seq)))
 \f
 ;;;; Scanning
 
@@ -168,10 +162,12 @@ USA.
                 (unscan-loop names** (&triple-third body)
                   (lambda (names*** body***)
                     (receiver names***
-                              (&typed-triple-cons sequence-3-type
-                                                  body*
-                                                  body**
-                                                  body***)))))))))
+                              (&typed-pair-cons sequence-2-type
+                                                body*
+                                                (&typed-pair-cons
+                                                 sequence-2-type
+                                                 body**
+                                                 body***))))))))))
        (else
         (receiver names
                   body))))

diff --git a/src/runtime/scomb.scm b/src/runtime/scomb.scm
index bf8e9a1da24baf6c6da9e70ca67b3cf360d5401f..5a92ec731651ca3b276e6ab0ec5e3f5d24778b09 100644 (file)
--- a/src/runtime/scomb.scm
+++ b/src/runtime/scomb.scm
@@ -128,17 +128,11 @@ USA.
   (if (null? actions)
       (error "MAKE-SEQUENCE: No actions"))
   (let loop ((actions actions))
-    (cond ((null? (cdr actions))
-          (car actions))
-         ((null? (cddr actions))
-          (&typed-pair-cons (ucode-type sequence-2)
-                            (car actions)
-                            (cadr actions)))
-         (else
-          (&typed-triple-cons (ucode-type sequence-3)
-                              (car actions)
-                              (cadr actions)
-                              (loop (cddr actions)))))))
+    (if (null? (cdr actions))
+       (car actions)
+       (&typed-pair-cons (ucode-type sequence-2)
+                         (car actions)
+                         (loop (cdr actions))))))
 
 (define (sequence? object)
   (or (object-type? (ucode-type sequence-2) object)