From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 27 Sep 2009 10:08:25 +0000 (-0700)
Subject: Don't signal compiler errors while linking.
X-Git-Tag: 20100708-Gtk~307
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b7cac4c1a1552dc7148474fc1babe4983a35f233;p=mit-scheme.git

Don't signal compiler errors while linking.
---

diff --git a/src/runtime/regsexp.scm b/src/runtime/regsexp.scm
index 1674e7cad..ddac4b36e 100644
--- a/src/runtime/regsexp.scm
+++ b/src/runtime/regsexp.scm
@@ -35,24 +35,30 @@ USA.
 (declare (usual-integrations))
 
 (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))