Finish replacing type code SEQUENCE-2 with SEQUENCE.

Hack runtime.sf to inform older hosts about new type code.

diff --git a/src/compiler/fggen/canon.scm b/src/compiler/fggen/canon.scm
index dae64f82d87cf39ee3107221cc747647ac68e058..c6c701448d8393f3f483d3c048ea0a14e97b221e 100644 (file)
--- a/src/compiler/fggen/canon.scm
+++ b/src/compiler/fggen/canon.scm
@@ -869,7 +869,7 @@ ARBITRARY:  The expression may be executed more than once.  It
       (standard-entry the-environment)
       (dispatch-entry combination canonicalize/combination)
       (dispatch-entries (lambda lexpr extended-lambda) canonicalize/lambda)
-      (dispatch-entry sequence-2 canonicalize/sequence))
+      (dispatch-entry sequence canonicalize/sequence))
     (named-lambda (canonicalize/expression expression bound context)
       ((vector-ref dispatch-vector (object-type expression))
        expression bound context))))
\ No newline at end of file

diff --git a/src/compiler/fggen/fggen.scm b/src/compiler/fggen/fggen.scm
index 5b0393a6df57f7241d87ab03c7a4892b7e44af5e..3efed1d39da8afe22f4f1da4ecdb07de92b9fc37 100644 (file)
--- a/src/compiler/fggen/fggen.scm
+++ b/src/compiler/fggen/fggen.scm
@@ -990,7 +990,7 @@ USA.
       (standard-entry the-environment)
       (standard-entry variable)
       (dispatch-entries (lambda lexpr extended-lambda) generate/lambda)
-      (dispatch-entry sequence-2 generate/sequence)
+      (dispatch-entry sequence generate/sequence)
       (dispatch-entry combination generate/combination)
       (dispatch-entry comment generate/comment))
     (named-lambda (generate/expression block continuation context expression)

diff --git a/src/runtime/codwlk.scm b/src/runtime/codwlk.scm
index 92342fc0ebb82887f8c4b93e9abe4b0b959f473c..54680342f3337f1c1f0032ab3497485185fc0e64 100644 (file)
--- a/src/runtime/codwlk.scm
+++ b/src/runtime/codwlk.scm
@@ -120,7 +120,7 @@ USA.
                      (EXTENDED-LAMBDA ,walk/extended-lambda)
                      ((LAMBDA LEXPR) ,walk/lambda)
                      (QUOTATION ,walk/quotation)
-                     (SEQUENCE-2 ,walk/sequence)
+                     (SEQUENCE ,walk/sequence)
                      (THE-ENVIRONMENT ,walk/the-environment)
                      (VARIABLE ,walk/variable)))
          table)))

diff --git a/src/runtime/prgcop.scm b/src/runtime/prgcop.scm
index b98839f17cbe1f638b82a9ec22c468afc2e6e99f..d89f2b310a56afe3967f125250cddf812f38364a 100644 (file)
--- a/src/runtime/prgcop.scm
+++ b/src/runtime/prgcop.scm
@@ -227,8 +227,8 @@ USA.
     typed))
 \f
 (define (copy-SEQUENCE-object obj)
-  (if (object-type? (ucode-type SEQUENCE-2) obj)
-      (%%copy-pair (ucode-type SEQUENCE-2) obj)
+  (if (object-type? (ucode-type SEQUENCE) obj)
+      (%%copy-pair (ucode-type SEQUENCE) obj)
       (error "copy-SEQUENCE-object: Unknown type" obj)))
 
 (define (copy-COMBINATION-object obj)

diff --git a/src/runtime/runtime.sf b/src/runtime/runtime.sf
index 9cb0e82334a42d3b5d9c5666f72ac2702a936819..f6d36ad3218c1b300c00d8e1701b380444f56c87 100644 (file)
--- a/src/runtime/runtime.sf
+++ b/src/runtime/runtime.sf
@@ -24,6 +24,14 @@ USA.
 
 |#
 
+;; Temporarily: ensure host knows new type code SEQUENCE.  Older hosts
+;; have an equivalent SEQUENCE-2 and type-aliases.
+(if (not (microcode-type/name->code 'sequence))
+    (let ((env (->environment '(runtime microcode-tables))))
+      (set! (access type-aliases env)
+           (cons '(sequence-2 sequence)
+                 (access type-aliases env)))))
+
 (load-option '*PARSER)                 ;for url.scm
 (fluid-let ((sf/default-syntax-table (->environment '(RUNTIME))))
   (sf-conditionally "char")

diff --git a/src/runtime/scan.scm b/src/runtime/scan.scm
index b795dc9ac9260899364137aa8040f0fc4ad2580d..6b02438438b511ed4a4c35ae5b486828e6b3bdd2 100644 (file)
--- a/src/runtime/scan.scm
+++ b/src/runtime/scan.scm
@@ -49,7 +49,7 @@ USA.
   ((ucode-primitive string->symbol) "#[open-block]"))
 
 (define-integrable sequence-type
-  (ucode-type sequence-2))
+  (ucode-type sequence))
 
 (define null-sequence
   '(NULL-SEQUENCE))

diff --git a/src/runtime/scomb.scm b/src/runtime/scomb.scm
index ebf03b6bebd95681fe284c2eee2cc3d14525791a..53eed8607ceb460fce283f1dc05e99497d805913 100644 (file)
--- a/src/runtime/scomb.scm
+++ b/src/runtime/scomb.scm
@@ -33,10 +33,10 @@ USA.
 ;;;; Sequence
 
 (define-integrable (%make-sequence first second)
-  (&typed-pair-cons (ucode-type sequence-2) first second))
+  (&typed-pair-cons (ucode-type sequence) first second))
 
 (define-integrable (sequence? object)
-  (object-type? (ucode-type sequence-2) object))
+  (object-type? (ucode-type sequence) object))
 
 (define-integrable (%sequence-immediate-first sequence) (&pair-car sequence))
 (define-integrable (%sequence-immediate-second sequence) (&pair-cdr sequence))

diff --git a/src/runtime/unpars.scm b/src/runtime/unpars.scm
index 016ca0986427428dbe59a3c4f283344d5d8bc2a8..cd39c15204c3b27d441ba39e13f01f74e2785cb9 100644 (file)
--- a/src/runtime/unpars.scm
+++ b/src/runtime/unpars.scm
@@ -295,8 +295,7 @@ USA.
     (EXTENDED-PROCEDURE . PROCEDURE)
     (PRIMITIVE . PRIMITIVE-PROCEDURE)
     (LEXPR . LAMBDA)
-    (EXTENDED-LAMBDA . LAMBDA)
-    (SEQUENCE-2 . SEQUENCE)))
+    (EXTENDED-LAMBDA . LAMBDA)))
 \f
 (define (unparse/false object)
   (if (eq? object #f)

diff --git a/src/runtime/utabs.scm b/src/runtime/utabs.scm
index a49e349776be18b32afbd8e4282d5bb9e9be44cd..b9c0243cfb0a08a8101c3599b49fe395139a7fe8 100644 (file)
--- a/src/runtime/utabs.scm
+++ b/src/runtime/utabs.scm
@@ -168,8 +168,7 @@ USA.
 (define (microcode-return/code-limit)
   (vector-length (vector-ref (get-fixed-objects-vector) returns-slot)))
 
-(define returns-aliases
-  '((sequence-continue sequence-2-second)))
+(define returns-aliases '())
 
 (define errors-slot)
 
@@ -257,7 +256,6 @@ USA.
     (BIGNUM BIG-FIXNUM)
     (PROMISE DELAYED)
     (FIXNUM ADDRESS POSITIVE-FIXNUM NEGATIVE-FIXNUM)
-    (SEQUENCE SEQUENCE-2)
     (STRING CHARACTER-STRING VECTOR-8B)
     (HUNK3-A UNMARKED-HISTORY)
     (TRIPLE HUNK3 HUNK3-B MARKED-HISTORY)