Recognize open-blocks even if they appear in a sequence-2.

diff --git a/src/runtime/scan.scm b/src/runtime/scan.scm
index 34223f91d0bce348aa0f6aab2e779b4ab0b980cb..d4a870e739a1cd4650c331aee5bbcf13c1e7ad6a 100644 (file)
--- a/src/runtime/scan.scm
+++ b/src/runtime/scan.scm
@@ -79,9 +79,19 @@ USA.
 
 (define (scan-loop expression receiver)
   (cond ((object-type? sequence-2-type expression)
-        (scan-loop (&pair-cdr expression)
-                   (scan-loop (&pair-car expression)
-                              receiver)))
+        (let ((first (&pair-car expression)))
+          (if (and (vector? first)
+                   (not (zero? (vector-length first)))
+                   (eq? (vector-ref first 0) open-block-tag))
+              (scan-loop
+               (&pair-cdr (&pair-cdr expression))
+               (lambda (names declarations body)
+                 (receiver (append (vector-ref first 1) names)
+                           (append (vector-ref first 2) declarations)
+                           body)))
+              (scan-loop (&pair-cdr expression)
+                         (scan-loop first
+                                    receiver)))))
        ((object-type? sequence-3-type expression)
         (let ((first (&triple-first expression)))
           (if (and (vector? first)
@@ -184,14 +194,23 @@ USA.
        body)))
 
 (define (open-block? object)
-  (and (object-type? sequence-3-type object)
-       (vector? (&triple-first object))
-       (eq? (vector-ref (&triple-first object) 0) open-block-tag)))
+  (or (and (object-type? sequence-2-type object)
+          (vector? (&pair-car object))
+          (eq? (vector-ref (&pair-car object) 0) open-block-tag))
+      (and (object-type? sequence-3-type object)
+          (vector? (&triple-first object))
+          (eq? (vector-ref (&triple-first object) 0) open-block-tag))))
 
 (define-guarantee open-block "SCode open-block")
 
 (define (open-block-components open-block receiver)
   (guarantee-open-block open-block 'OPEN-BLOCK-COMPONENTS)
-  (receiver (vector-ref (&triple-first open-block) 1)
-           (vector-ref (&triple-first open-block) 2)
-           (&triple-third open-block)))
\ No newline at end of file
+  (cond ((object-type? sequence-2-type open-block)
+        (receiver (vector-ref (&pair-car open-block) 1)
+                  (vector-ref (&pair-car open-block) 2)
+                  (&pair-cdr (&pair-cdr open-block))))
+       ((object-type? sequence-3-type open-block)
+        (receiver (vector-ref (&triple-first open-block) 1)
+                  (vector-ref (&triple-first open-block) 2)
+                  (&triple-third open-block)))
+       (else (error:not-open-block open-block 'open-block-components))))
\ No newline at end of file