Don't signal compiler errors while linking.

diff --git a/src/runtime/regsexp.scm b/src/runtime/regsexp.scm
index 1674e7cade616b9723a1ce308141bae765043772..ddac4b36e52dc23caf1e257eef1311fd5cb77a0e 100644 (file)
--- a/src/runtime/regsexp.scm
+++ b/src/runtime/regsexp.scm
@@ -35,24 +35,30 @@ USA.
 (declare (usual-integrations))
 \f
 (define (compile-regsexp regsexp)
-  (bind-condition-handler (list condition-type:error)
-      (lambda (condition)
-       (signal-compile-error regsexp condition))
-    (lambda ()
-      (%make-compiled-regsexp
-       ((%compile-regsexp regsexp) %top-level-success)))))
+  (%link-insn
+   (bind-condition-handler (list condition-type:error)
+       (lambda (condition)
+        (signal-compile-error regsexp condition))
+     (lambda ()
+       (%compile-regsexp regsexp)))))
+
+(define (%link-insn insn)
+  (%make-compiled-regsexp
+   (insn
+    (lambda (position groups fail)
+      fail
+      (cons (get-index position)
+           (%convert-groups groups))))))
 
 (define-record-type <compiled-regsexp>
-    (%make-compiled-regsexp insn)
+    (%make-compiled-regsexp impl)
     compiled-regsexp?
-  (insn %compiled-regsexp-insn))
+  (impl %compiled-regsexp-impl))
 
 (define-guarantee compiled-regsexp "compiled regular s-expression")
 
-(define (%top-level-success position groups fail)
-  fail
-  (cons (get-index position)
-       (%convert-groups groups)))
+(define (%top-level-match crsexp start-position)
+  ((%compiled-regsexp-impl crsexp) start-position '() (lambda () #f)))
 
 (define (%compile-regsexp regsexp)
   (cond ((unicode-char? regsexp)
@@ -535,11 +541,6 @@ USA.
                               #f
                               char)))))))
 
-(define (%top-level-match crsexp start-position)
-  ((%compiled-regsexp-insn crsexp) start-position
-                                  '()
-                                  (lambda () #f)))
-
 (define (%char-source->position source)
   (%make-source-position 0 (source) #f source))