From: Joe Marshall <jmarshall@alum.mit.edu>
Date: Mon, 15 Mar 2010 02:18:15 +0000 (-0700)
Subject: Avoid constructing sequence-3 objects.
X-Git-Tag: 20100708-Gtk~94
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=fb9d1518e8888afc5ed6f7a511c3c0bb79f0d377;p=mit-scheme.git

Avoid constructing sequence-3 objects.
---

diff --git a/src/runtime/scan.scm b/src/runtime/scan.scm
index 595e733d4..74334c6ad 100644
--- 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)))
 
 ;;;; 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 bf8e9a1da..5a92ec731 100644
--- 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)