From 2b9b2cce094b65ef51e007e6e96ceccc91ddef6d Mon Sep 17 00:00:00 2001 From: Joe Marshall Date: Mon, 13 Jun 2011 16:02:13 -0700 Subject: [PATCH] Tweak integrations. --- src/runtime/parser-buffer.scm | 71 +++++++++++++++++++---------------- 1 file changed, 39 insertions(+), 32 deletions(-) diff --git a/src/runtime/parser-buffer.scm b/src/runtime/parser-buffer.scm index fbfafbadc..00bfe51fe 100644 --- a/src/runtime/parser-buffer.scm +++ b/src/runtime/parser-buffer.scm @@ -225,6 +225,11 @@ USA. (define (match-parser-buffer-not-char-ci-no-advance buffer char) (match-char-not-no-advance buffer char char-ci=?)) +(define-integrable char-in-set? + (lambda (char set) + (declare (integrate char set)) + (char-set-member? set char))) + (define (match-parser-buffer-char-in-set buffer set) (match-char buffer set char-in-set?)) @@ -237,9 +242,6 @@ USA. (define (match-parser-buffer-char-not-in-set-no-advance buffer set) (match-char-not-no-advance buffer set char-in-set?)) -(define-integrable (char-in-set? char set) - (char-set-member? set char)) - (define-integrable (match-char buffer reference compare) (and (guarantee-buffer-chars buffer 1) (let ((char @@ -268,6 +270,40 @@ USA. (declare (integrate c1 c2)) (not (compare c1 c2))))) +(declare (integrate match-substring-loop)) +(define (match-substring-loop buffer string start end + compare extract) + (declare (integrate compare extract)) + (and (guarantee-buffer-chars buffer (fix:- end start)) + (let ((bs (parser-buffer-string buffer))) + (let loop + ((i start) + (bi (parser-buffer-index buffer)) + (bl (parser-buffer-line buffer))) + (if (fix:< i end) + (and (compare (extract string i) (wide-string-ref bs bi)) + (loop (fix:+ i 1) + (fix:+ bi 1) + (if (char=? (wide-string-ref bs bi) #\newline) + (fix:+ bl 1) + bl))) + (begin + (set-parser-buffer-index! buffer bi) + (set-parser-buffer-line! buffer bl) + #t)))))) + +(declare (integrate match-substring-loop-na)) +(define (match-substring-loop-na buffer string start end + compare extract) + (declare (integrate compare extract)) + (and (guarantee-buffer-chars buffer (fix:- end start)) + (let ((bs (parser-buffer-string buffer))) + (let loop ((i start) (bi (parser-buffer-index buffer))) + (if (fix:< i end) + (and (compare (extract string i) (wide-string-ref bs bi)) + (loop (fix:+ i 1) (fix:+ bi 1))) + #t))))) + (define (match-parser-buffer-string buffer string) (match-string buffer string match-substring-loop char=?)) @@ -316,35 +352,6 @@ USA. (else (error:wrong-type-argument string "string" #f)))) -(define-integrable (match-substring-loop buffer string start end - compare extract) - (and (guarantee-buffer-chars buffer (fix:- end start)) - (let ((bs (parser-buffer-string buffer))) - (let loop - ((i start) - (bi (parser-buffer-index buffer)) - (bl (parser-buffer-line buffer))) - (if (fix:< i end) - (and (compare (extract string i) (wide-string-ref bs bi)) - (loop (fix:+ i 1) - (fix:+ bi 1) - (if (char=? (wide-string-ref bs bi) #\newline) - (fix:+ bl 1) - bl))) - (begin - (set-parser-buffer-index! buffer bi) - (set-parser-buffer-line! buffer bl) - #t)))))) - -(define-integrable (match-substring-loop-na buffer string start end - compare extract) - (and (guarantee-buffer-chars buffer (fix:- end start)) - (let ((bs (parser-buffer-string buffer))) - (let loop ((i start) (bi (parser-buffer-index buffer))) - (if (fix:< i end) - (and (compare (extract string i) (wide-string-ref bs bi)) - (loop (fix:+ i 1) (fix:+ bi 1))) - #t))))) (define-integrable (increment-buffer-index! buffer char) (set-parser-buffer-index! buffer (fix:+ (parser-buffer-index buffer) 1)) -- 2.25.1