[Chicken-users] regex diff + how to check for foreign type?

[Joerg F. Wittenberger]

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)])