[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Chicken-users] regex diff + how to check for foreign type?
From: |
Joerg F. Wittenberger |
Subject: |
[Chicken-users] regex diff + how to check for foreign type? |
Date: |
21 Nov 2002 16:41:18 +0100 |
Hi all,
it occured to me that the chicken regex module doesn't allow to
precompile regualr expressions. Here some modifications which
apparently work. Coding took me to the question how do I check for a
foreign type. This code allows to use strings or precompiled regular
expressions. But it only checks for strings and assumes otherwise the
argument to be a precompiled expression. How could I improve the
situation?
so short
/Jörg
--
The worst of harm may often result from the best of intentions.
--- regex-orig.scm Thu Nov 21 14:58:59 2002
+++ regex.scm Thu Nov 21 15:17:13 2002
@@ -101,39 +101,38 @@
;;; Compile regular expression into pattern buffer:
(define ##regexp#re-compile-pattern
(foreign-lambda* int ((c-string rx) (c-pointer buffer))
"return(regcomp((regex_t *)buffer, rx, REG_EXTENDED));") )
(define ##regexp#compile
(let ([error error])
- (lambda (regexp loc)
- (##sys#check-string regexp loc)
+ (lambda (regexp) ;; loc)
+ ;; string check no longer useful (##sys#check-string regexp loc)
(let ([index #f])
(let loop ([i 0])
(cond [(fx>= i ##regexp#buffer-count)
(set! index ##regexp#buffer-index)
(set! ##regexp#buffer-index (fx+ index 1))
(when (fx>= ##regexp#buffer-index ##regexp#buffer-count)
(set! ##regexp#buffer-index 0) ) ]
[(string=? regexp (##sys#slot (##sys#slot ##regexp#buffers i)
0))
(set! index i) ]
[else (loop (fx+ i 1))] ) )
(let ([b (##sys#slot ##regexp#buffers index)])
(if (zero? (##regexp#re-compile-pattern regexp (##sys#slot b 1)))
(##sys#setslot b 0 regexp)
(##sys#error "can not compile regular expression" regexp) )
(##sys#slot b 1) ) ) ) ) )
-
;;; Gather matched result strings or positions:
(define (##regexp#gather-result-positions result b)
(and (zero? result)
(let ([n (##core#inline "C_regexp_count_matches" b)])
(let loop ([i 0])
(if (fx>= i n)
'()
(let ([start (##core#inline "C_regexp_register_start" i)])
(cons
@@ -161,28 +160,38 @@
"n = rx->re_nsub + 1;"
"r = regexec((regex_t *)buffer, str + start, n, C_match_registers, 0);"
"if(start != 0) {"
" for(i = 0; i < n; ++i) {"
" C_match_registers[ i ].rm_so += start;"
" C_match_registers[ i ].rm_eo += start;"
" }"
"}"
"return(r);") )
+(define-foreign-type regex (pointer "regex_t"))
+
+
(let ([b #f]
[string-append string-append] )
+ (set! regex-compile
+ (lambda (str)
+ (##sys#check-string str 'regex-compile)
+ (##regexp#compile str)))
+
(define (prepare regexp str start loc)
(##sys#check-string str loc)
(let ([si (if (pair? start) (##sys#slot start 0) 0)])
(##sys#check-exact si loc)
- (set! b (##regexp#compile (string-append "^" regexp "$") loc))
+ (set! b (if (string? regexp)
+ (##regexp#compile (string-append "^" regexp "$"))
+ regexp))
(##regexp#re-match b str si 0) ) )
(set! string-match
(lambda (regexp str . start)
(let ([m (prepare regexp str start 'string-match)])
(##regexp#gather-results m str b) ) ) )
(set! string-match-positions
(lambda (regexp str . start)
(let ([m (prepare regexp str start 'string-match-positions)])
@@ -194,21 +203,21 @@
(let ([b #f])
(define (prepare regexp str start-and-range loc)
(##sys#check-string str loc)
(let* ([range (and (##core#inline "C_blockp" start-and-range)
(##sys#slot start-and-range 1) ) ]
[si (if range (##sys#slot start-and-range 0) 0)]
[ri (if (##core#inline "C_blockp" range) (##sys#slot range 0) 0)] )
(##sys#check-exact si loc)
(##sys#check-exact ri loc)
- (set! b (##regexp#compile regexp loc))
+ (set! b (if (string? regexp) (##regexp#compile regexp) regexp))
(##regexp#re-match b str si ri) ) )
(set! string-search
(lambda (regexp str . start-and-range)
(let ([s (prepare regexp str start-and-range 'string-search)])
(##regexp#gather-results s str b) ) ) )
(set! string-search-positions
(lambda (regexp str . start-and-range)
(let ([s (prepare regexp str start-and-range 'string-search-positions)])
- [Chicken-users] regex diff + how to check for foreign type?,
Joerg F. Wittenberger <=