From b7cac4c1a1552dc7148474fc1babe4983a35f233 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sun, 27 Sep 2009 03:08:25 -0700 Subject: [PATCH] Don't signal compiler errors while linking. --- src/runtime/regsexp.scm | 35 ++++++++++++++++++----------------- 1 file changed, 18 insertions(+), 17 deletions(-) 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 - (%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)) -- 2.25.1