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

diff --git a/src/runtime/prgcop.scm b/src/runtime/prgcop.scm
index 0550a2dc4b1900b854fde66efb3de22954e0d026..116adf54e126bb6de6f81a0f8f1c38c73bdea353 100644 (file)
--- 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 5a6ccdf961ddd225c07f860ec76af3140c529e9e..b9bcf227f79ea700efb4fc212cac8e3157484fa7 100644 (file)
--- 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)))
 \f
 (define-syntax combination-dispatch
   (sc-macro-transformer