From: Joe Marshall <eval.apply@gmail.com>
Date: Wed, 25 Jan 2012 16:36:57 +0000 (-0800)
Subject: Combinations no longer constructed with pcomb1, pcomb2, comb1, etc.
X-Git-Tag: release-9.2.0~332^2~2
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=6dab1a32809443914369a1164ca0c11902b9fccf;p=mit-scheme.git

Combinations no longer constructed with pcomb1, pcomb2, comb1, etc.
---

diff --git a/src/runtime/prgcop.scm b/src/runtime/prgcop.scm
index 0550a2dc4..116adf54e 100644
--- a/src/runtime/prgcop.scm
+++ b/src/runtime/prgcop.scm
@@ -232,22 +232,9 @@ USA.
       (error "copy-SEQUENCE-object: Unknown type" obj)))
 
 (define (copy-COMBINATION-object obj)
-  (cond ((object-type? (ucode-type combination) obj)
-	 (%%copy-vector (ucode-type combination) obj))
-	((object-type? (ucode-type combination-1) obj)
-	 (%%copy-pair (ucode-type combination-1) obj))
-	((object-type? (ucode-type combination-2) obj)
-	 (%%copy-triple (ucode-type combination-2) obj))
-	((object-type? (ucode-type primitive-combination-0) obj)
-	 obj)					; Non-pointer
-	((object-type? (ucode-type primitive-combination-1) obj)
-	 (%%copy-pair (ucode-type primitive-combination-1) obj))
-	((object-type? (ucode-type primitive-combination-2) obj)
-	 (%%copy-triple (ucode-type primitive-combination-2) obj))
-	((object-type? (ucode-type primitive-combination-3) obj)
-	 (%%copy-vector (ucode-type primitive-combination-3) obj))
-	(else
-	 (error "copy-COMBINATION-object: Unknown type" obj))))
+  (make-combination
+   (copy-object (combination-operator obj))
+   (map copy-object (combination-operands obj))))
 
 (define (copy-LAMBDA-object obj)
   (cond ((object-type? (ucode-type lambda) obj)
diff --git a/src/runtime/scomb.scm b/src/runtime/scomb.scm
index 5a6ccdf96..b9bcf227f 100644
--- a/src/runtime/scomb.scm
+++ b/src/runtime/scomb.scm
@@ -161,71 +161,8 @@ USA.
 (define-guarantee combination "SCode combination")
 
 (define (make-combination operator operands)
-
-  (define-integrable (%make-combination-0 operator)
-    (if (and (primitive-procedure? operator)
-	     (= (primitive-procedure-arity operator) 0))
-	(object-new-type (ucode-type primitive-combination-0) operator)
-	(&typed-vector-cons (ucode-type combination)
-			    (cons operator '()))))
-
-  (define-integrable (%make-combination-1 operator operand0)
-    (if (and (primitive-procedure? operator)
-	     (= (primitive-procedure-arity operator) 1))
-	(&typed-pair-cons (ucode-type primitive-combination-1)
-			  operator operand0)
-	(&typed-pair-cons (ucode-type combination-1)
-			  operator operand0)))
-
-  (define-integrable (%make-combination-2 operator operand0 operand1)
-    (if (and (primitive-procedure? operator)
-	     (= (primitive-procedure-arity operator) 2))
-	(&typed-triple-cons (ucode-type primitive-combination-2)
-			    operator operand0 operand1)
-	(&typed-triple-cons (ucode-type combination-2)
-			    operator operand0 operand1)))
-
-  (define-integrable (%make-combination-3 operator)
-    (if (and (primitive-procedure? operator)
-	     (= (primitive-procedure-arity operator) 3))
-	(&typed-vector-cons (ucode-type primitive-combination-3)
-			    (cons operator operands))
-	(&typed-vector-cons (ucode-type combination)
-			    (cons operator operands))))
-
-  (cond ((pair? operands)
-	 (let ((operand0 (car operands))
-	       (tail0 (cdr operands)))
-	   (cond ((pair? tail0)
-		  (let ((operand1 (car tail0))
-			(tail1 (cdr tail0)))
-		    (cond ((pair? tail1)
-			   (let ((tail2 (cdr tail1)))
-			     (cond ((pair? tail2)
-				    (&typed-vector-cons
-				     (ucode-type combination)
-				     (cons operator operands)))
-				   ((null? tail2)
-				    (%make-combination-3 operator))
-				   (else (&typed-vector-cons
-					  (ucode-type combination)
-					  (cons operator operands))))))
-			  ((null? tail1)
-			   (%make-combination-2 operator operand0 operand1))
-			  (else (&typed-vector-cons
-				 (ucode-type combination)
-				 (cons operator operands))))))
-		 ((null? tail0)
-		  (%make-combination-1 operator operand0))
-		 (else (&typed-vector-cons
-			(ucode-type combination)
-			(cons operator operands))))))
-	((null? operands)
-	 (%make-combination-0 operator))
-	(else (&typed-vector-cons
-	       (ucode-type combination)
-	       (cons operator operands)))))
-
+  (&typed-vector-cons (ucode-type combination)
+		      (cons operator operands)))
 
 (define-syntax combination-dispatch
   (sc-macro-transformer