Remove alternate/optimized types of scode combinations from runtime.

diff --git a/src/compiler/fggen/canon.scm b/src/compiler/fggen/canon.scm
index 8b376f2153e335785736e0929821e6b4bd3cd999..dae64f82d87cf39ee3107221cc747647ac68e058 100644 (file)
--- a/src/compiler/fggen/canon.scm
+++ b/src/compiler/fggen/canon.scm
@@ -867,12 +867,7 @@ ARBITRARY: The expression may be executed more than once.  It
       (binary-entry disjunction)
       (standard-entry variable)
       (standard-entry the-environment)
-      (dispatch-entries (combination-1 combination-2 combination
-                                      primitive-combination-0
-                                      primitive-combination-1
-                                      primitive-combination-2
-                                      primitive-combination-3)
-                       canonicalize/combination)
+      (dispatch-entry combination canonicalize/combination)
       (dispatch-entries (lambda lexpr extended-lambda) canonicalize/lambda)
       (dispatch-entry sequence-2 canonicalize/sequence))
     (named-lambda (canonicalize/expression expression bound context)

diff --git a/src/compiler/fggen/fggen.scm b/src/compiler/fggen/fggen.scm
index 32c8eb946720c93c96f5b671c2c3ceceb53b3108..9ce8396e719ecafdc2f917948b889bc5c2edbb96 100644 (file)
--- a/src/compiler/fggen/fggen.scm
+++ b/src/compiler/fggen/fggen.scm
@@ -991,12 +991,7 @@ USA.
       (standard-entry variable)
       (dispatch-entries (lambda lexpr extended-lambda) generate/lambda)
       (dispatch-entry sequence-2 generate/sequence)
-      (dispatch-entries (combination-1 combination-2 combination
-                                      primitive-combination-0
-                                      primitive-combination-1
-                                      primitive-combination-2
-                                      primitive-combination-3)
-                       generate/combination)
+      (dispatch-entry combination generate/combination)
       (dispatch-entry comment generate/comment))
     (named-lambda (generate/expression block continuation context expression)
       ((vector-ref dispatch-vector (object-type expression))

diff --git a/src/runtime/codwlk.scm b/src/runtime/codwlk.scm
index 396b41cc92e02a2103b07fff59f03b87ea4e375c..92342fc0ebb82887f8c4b93e9abe4b0b959f473c 100644 (file)
--- a/src/runtime/codwlk.scm
+++ b/src/runtime/codwlk.scm
@@ -111,14 +111,7 @@ USA.
                            (kernel (car entry)))))
                    `((ACCESS ,walk/access)
                      (ASSIGNMENT ,walk/assignment)
-                     ((COMBINATION
-                       COMBINATION-1
-                       COMBINATION-2
-                       PRIMITIVE-COMBINATION-0
-                       PRIMITIVE-COMBINATION-1
-                       PRIMITIVE-COMBINATION-2
-                       PRIMITIVE-COMBINATION-3)
-                      ,walk/combination)
+                     (COMBINATION ,walk/combination)
                      (COMMENT ,walk/comment)
                      (CONDITIONAL ,walk/conditional)
                      (DEFINITION ,walk/definition)

diff --git a/src/runtime/conpar.scm b/src/runtime/conpar.scm
index 5ff34ebf28c8ea691ea940a3b7c5a66ad9aae00b..02f233bbc18451aaa744e8e31f45156838acd43d 100644 (file)
--- a/src/runtime/conpar.scm
+++ b/src/runtime/conpar.scm
@@ -806,20 +806,11 @@ USA.
 
     (standard-subproblem 'ACCESS-CONTINUE 2)
     (standard-subproblem 'ASSIGNMENT-CONTINUE 3)
-    (standard-subproblem 'COMBINATION-1-PROCEDURE 3)
-    (standard-subproblem 'COMBINATION-2-FIRST-OPERAND 3)
-    (standard-subproblem 'COMBINATION-2-PROCEDURE 4)
     (standard-subproblem 'CONDITIONAL-DECIDE 3)
     (standard-subproblem 'DEFINITION-CONTINUE 3)
     (standard-subproblem 'DISJUNCTION-DECIDE 3)
     (standard-subproblem 'EVAL-ERROR 3)
     (standard-subproblem 'FORCE-SNAP-THUNK 2)
-    (standard-subproblem 'PRIMITIVE-COMBINATION-1-APPLY 2)
-    (standard-subproblem 'PRIMITIVE-COMBINATION-2-APPLY 3)
-    (standard-subproblem 'PRIMITIVE-COMBINATION-2-FIRST-OPERAND 3)
-    (standard-subproblem 'PRIMITIVE-COMBINATION-3-APPLY 4)
-    (standard-subproblem 'PRIMITIVE-COMBINATION-3-FIRST-OPERAND 4)
-    (standard-subproblem 'PRIMITIVE-COMBINATION-3-SECOND-OPERAND 3)
     (standard-subproblem 'SEQUENCE-2-SECOND 3)
 
     (standard-subproblem 'COMBINATION-SAVE-VALUE length/combination-save-value)

diff --git a/src/runtime/framex.scm b/src/runtime/framex.scm
index 941bee16c887087388e15489f2ed4be5c9f634cf..9f17a15bce55d334a9366b1f5e081e41969a1e59 100644 (file)
--- a/src/runtime/framex.scm
+++ b/src/runtime/framex.scm
@@ -115,12 +115,6 @@ USA.
            undefined-environment
            (validate-subexpression frame (select-subexpression expression)))))
 
-(define (method/primitive-combination-3-first-operand frame)
-  (let ((expression (stack-frame/ref frame 1)))
-    (values expression
-           (stack-frame/ref frame 3)
-           (validate-subexpression frame (&vector-ref expression 2)))))
-
 (define (method/combination-save-value frame)
   (let ((expression (stack-frame/ref frame 1)))
     (values expression
@@ -276,28 +270,12 @@ USA.
     (record-method 'SEQUENCE-2-SECOND method))
   (let ((method (method/standard &pair-cdr)))
     (record-method 'ASSIGNMENT-CONTINUE method)
-    (record-method 'COMBINATION-1-PROCEDURE method)
     (record-method 'DEFINITION-CONTINUE method))
   (let ((method (method/standard &triple-first)))
     (record-method 'CONDITIONAL-DECIDE method))
-  (let ((method (method/standard &triple-second)))
-    (record-method 'COMBINATION-2-PROCEDURE method))
-  (let ((method (method/standard &triple-third)))
-    (record-method 'COMBINATION-2-FIRST-OPERAND method)
-    (record-method 'PRIMITIVE-COMBINATION-2-FIRST-OPERAND method))
-  (record-method 'PRIMITIVE-COMBINATION-3-SECOND-OPERAND
-                (method/standard &vector-fourth))
   (let ((method (method/expression-only &pair-car)))
     (record-method 'ACCESS-CONTINUE method))
-  (record-method 'PRIMITIVE-COMBINATION-1-APPLY
-                (method/expression-only &pair-cdr))
-  (record-method 'PRIMITIVE-COMBINATION-2-APPLY
-                (method/expression-only &triple-second))
-  (record-method 'PRIMITIVE-COMBINATION-3-APPLY
-                (method/expression-only &vector-second))
   (record-method 'COMBINATION-SAVE-VALUE method/combination-save-value)
-  (record-method 'PRIMITIVE-COMBINATION-3-FIRST-OPERAND
-                method/primitive-combination-3-first-operand)
   (record-method 'EVAL-ERROR method/eval-error)
   (record-method 'FORCE-SNAP-THUNK method/force-snap-thunk)
   (let ((method (method/application-frame 3)))

diff --git a/src/runtime/scomb.scm b/src/runtime/scomb.scm
index 6d466552cd8cac8d41a0582660cab01ee0cb3450..ebf03b6bebd95681fe284c2eee2cc3d14525791a 100644 (file)
--- a/src/runtime/scomb.scm
+++ b/src/runtime/scomb.scm
@@ -150,79 +150,34 @@ USA.
 ;;;; Combination
 
 (define (combination? object)
-  (or (object-type? (ucode-type combination) object)
-      (object-type? (ucode-type combination-1) object)
-      (object-type? (ucode-type combination-2) object)
-      (object-type? (ucode-type primitive-combination-0) object)
-      (object-type? (ucode-type primitive-combination-1) object)
-      (object-type? (ucode-type primitive-combination-2) object)
-      (object-type? (ucode-type primitive-combination-3) object)))
+  (object-type? (ucode-type combination) object))
 
 (define-guarantee combination "SCode combination")
 
 (define (make-combination operator operands)
   (&typed-vector-cons (ucode-type combination)
                      (cons operator operands)))
-\f
-(define-syntax combination-dispatch
-  (sc-macro-transformer
-   (lambda (form environment)
-     (let ((name (list-ref form 1))
-          (combination (close-syntax (list-ref form 2) environment))
-          (case-0 (close-syntax (list-ref form 3) environment))
-          (case-1 (close-syntax (list-ref form 4) environment))
-          (case-2 (close-syntax (list-ref form 5) environment))
-          (case-n (close-syntax (list-ref form 6) environment)))
-       `(COND ((OBJECT-TYPE? (UCODE-TYPE PRIMITIVE-COMBINATION-0)
-                            ,combination)
-              ,case-0)
-             ((OR (OBJECT-TYPE? (UCODE-TYPE COMBINATION-1) ,combination)
-                  (OBJECT-TYPE? (UCODE-TYPE PRIMITIVE-COMBINATION-1)
-                                ,combination))
-              ,case-1)
-             ((OR (OBJECT-TYPE? (UCODE-TYPE COMBINATION-2) ,combination)
-                  (OBJECT-TYPE? (UCODE-TYPE PRIMITIVE-COMBINATION-2)
-                                ,combination))
-              ,case-2)
-             ((OR (OBJECT-TYPE? (UCODE-TYPE COMBINATION) ,combination)
-                  (OBJECT-TYPE? (UCODE-TYPE PRIMITIVE-COMBINATION-3)
-                                ,combination))
-              ,case-n)
-             (ELSE
-              (ERROR:NOT-COMBINATION ,combination ',name)))))))
 
 (define (combination-size combination)
-  (combination-dispatch combination-size combination
-                       1 2 3 (&vector-length combination)))
+  (guarantee-combination combination 'COMBINATION-SIZE)
+  (&vector-length combination))
 
 (define (combination-operator combination)
-  (combination-dispatch combination-operator combination
-                       (object-new-type (ucode-type primitive) combination)
-                       (&pair-car combination)
-                       (&triple-first combination)
-                       (&vector-ref combination 0)))
+  (guarantee-combination combination 'COMBINATION-OPERATOR)
+  (&vector-ref combination 0))
 
 (define (combination-operands combination)
-  (combination-dispatch
-   combination-operands combination
-   '()
-   (list (&pair-cdr combination))
-   (list (&triple-second combination) (&triple-third combination))
-   (&subvector->list combination 1 (&vector-length combination))))
+  (guarantee-combination combination 'COMBINATION-OPERANDS)
+  (&subvector->list combination 1 (&vector-length combination)))
 
 (define (combination-components combination receiver)
-  (combination-dispatch
-   combination-components combination
-   (receiver (object-new-type (ucode-type primitive) combination) '())
-   (receiver (&pair-car combination) (list (&pair-cdr combination)))
-   (receiver (&triple-first combination)
-            (list (&triple-second combination) (&triple-third combination)))
-   (receiver (&vector-ref combination 0)
-            (&subvector->list combination 1 (&vector-length combination)))))
+  (guarantee-combination combination 'COMBINATION-OPERANDS)
+  (receiver (&vector-ref combination 0)
+           (&subvector->list combination 1 (&vector-length combination))))
 
 (define (combination-subexpressions expression)
   (combination-components expression cons))
-\f
+
 ;;;; Unassigned?
 
 (define (make-unassigned? name)

diff --git a/src/runtime/unpars.scm b/src/runtime/unpars.scm
index bde57101ad1a85291fc1bdb07ecfabd25bd46e18..502ad1f16cc6adad0f80ce725a7a89eac4ff8abc 100644 (file)
--- a/src/runtime/unpars.scm
+++ b/src/runtime/unpars.scm
@@ -296,12 +296,6 @@ USA.
     (PRIMITIVE . PRIMITIVE-PROCEDURE)
     (LEXPR . LAMBDA)
     (EXTENDED-LAMBDA . LAMBDA)
-    (COMBINATION-1 . COMBINATION)
-    (COMBINATION-2 . COMBINATION)
-    (PRIMITIVE-COMBINATION-0 . COMBINATION)
-    (PRIMITIVE-COMBINATION-1 . COMBINATION)
-    (PRIMITIVE-COMBINATION-2 . COMBINATION)
-    (PRIMITIVE-COMBINATION-3 . COMBINATION)
     (SEQUENCE-2 . SEQUENCE)))
 \f
 (define (unparse/false object)