Ported to new FFI.

scsh/rx/packages.scm

@@ -203,6 +203,7 @@
 	ascii
 	primitives              ; JMG add-finalizer!
 	define-record-types     ; JMG debugging
+	external-calls
 	string-lib		; string-fold
 	scheme)
 

scsh/rx/re-low.scm

@@ -65,6 +65,9 @@
 (define-record-discloser :cre
         (lambda (self) (list "cre" (cre:string self))))
 
+(define-record-resumer :cre (lambda (cre)
+			      (set-cre:bytes cre #f)
+			      (set-cre:bytes/nm cre #f)))
 
 (define (make-cre str max-paren tvec)
   (really-make-cre str max-paren #f #f tvec #f))
@@ -76,15 +79,15 @@
   (vfold (lambda (sm mlpsm) (if sm (max mlpsm sm) mlpsm)) 0 tvec))
 
 (define (compile-posix-re->c-struct re-string sm?)
-  (receive (errcode c-struct) (%compile-re re-string sm?)
+  (let ((maybe-struct (%compile-re re-string sm?)))
-    (if (zero? errcode) c-struct
+    (if (pair? maybe-struct)
-	(error errcode (%regerror-msg errcode c-struct)
+	(error (car maybe-struct)
-	       compile-posix-re->c-struct re-string sm?))))
+	       (%regerror-msg (car maybe-struct) (cdr maybe-struct))
-
+	       compile-posix-re->c-struct re-string sm?)
-(define-foreign %compile-re (compile_re (string-desc pattern) (bool submatches?))
+	maybe-struct)))
-  integer ; 0 or error code
-  (C regex_t*))
 
+;;; returns pointer as number or a pair of error number and 0
+(define-stubless-foreign %compile-re (pattern submatches?) "compile_re")
 
 ;;; Searching with compiled regexps
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -121,25 +124,20 @@
 		      cre-search? cre str start)
 	       retcode)))))
 
-(define-foreign %cre-search
+; 0 success, #f no-match, or non-zero int error code:
-  (re_search ((C "const regex_t *~a") compiled-regexp)
+(define-stubless-foreign %cre-search 
-	      (string-desc str)
+  (compiled-regexp str start tvec max-psm svec evec) "re_search")
-	      (integer start)
+  
-	      (vector-desc tvec) (integer max-psm)
-	      (vector-desc svec) (vector-desc evec))
-  desc)	; 0 success, #f no-match, or non-zero int error code.
 
 
 ;;; Generate an error msg from an error code.
 
-(define-foreign %regerror-msg (re_errint2str (integer errcode)
+(define-stubless-foreign %regerror-msg (errcode re) "re_errint2str")
-					     ((C "const regex_t *~a") re))
-  string)
 
 
 ;;; Reclaiming compiled regexp storage
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define-foreign %free-re (free_re ((C regex_t*) re)) ignore)
+(define-stubless-foreign %free-re (re) "free_re")
 
 
 ;;; Whenever we make a new CRE, add the appropriate finalizer, 
@@ -151,7 +149,7 @@
       (warn "free-bytes called on #f")))
   
 (define (free-bytes/nm the-cre)
-    (if (cre:bytes the-cre)
+    (if (cre:bytes/nm the-cre)
 	(%free-re (cre:bytes/nm the-cre))
 	(warn "free-bytes/nm called on #f")))
 

scsh/rx/re1.c

@@ -8,6 +8,7 @@
 **   regex freeing
 **   regexp-string -> regex_t caching
 **   make filter_stringvec return an error code.
+**   TODO: filter_stringvec is used nowhere, why?
 */
 
 #include <stdlib.h>
@@ -26,24 +27,24 @@
 **   and return a non-zero error code.
 */
 
-int compile_re(s48_value re_str, int sm_p, regex_t **cr)
+s48_value compile_re(s48_value re_str, s48_value sm_p)
 {
-  // JMG: char *s = &STRING_REF(re_str, 0);
   char *s = s48_extract_string(re_str);
-    int len = S48_STRING_LENGTH(re_str);
+  int len = S48_STRING_LENGTH(re_str);
-    int err;
+  int err;
-    regex_t *re = Alloc(regex_t);
+  regex_t *re = Alloc(regex_t);
-
+  
-    if( !re ) return -1;
+  if( !re ) s48_raise_out_of_memory_error();
-    
+  
-    re->re_endp = s + len;
+  re->re_endp = s + len;
-    err = regcomp(re, s, REG_EXTENDED | REG_PEND
+  err = regcomp(re, s, REG_EXTENDED | REG_PEND
-		                      | (sm_p ? 0 : REG_NOSUB));
+		| ((sm_p != S48_FALSE) ? 0 : REG_NOSUB));
-    if( err ) {Free(re); *cr=0;}
+  if( err ) {
-    else *cr=re;
+    Free(re);
-
+    return s48_cons(s48_enter_fixnum (err), s48_enter_fixnum (0));
-    return err;
+  }
-    }
+  else return s48_enter_integer((unsigned long) re);
+}
 
 /* Do a regex search of RE through string STR, beginning at STR[START].
 ** - STR is passed as a Scheme value as it is allowed to contain nul bytes.
@@ -76,14 +77,15 @@ int compile_re(s48_value re_str, int sm_p, regex_t **cr)
 ** Return 0 on success; #f if no match; non-zero integer error code otherwise.
 */
 
-s48_value re_search(const regex_t *re, s48_value str, int start,
+s48_value re_search(s48_value _re, s48_value str, s48_value _start,
-		       s48_value trans_vec, int max_psm,
+		       s48_value trans_vec, s48_value _max_psm,
 		       s48_value start_vec, s48_value end_vec)
 {
-  // JMG: char *s = &STRING_REF(str,0);		/* Passed as a s48_value because */
+  const regex_t *re = (const regex_t *) s48_extract_integer (_re); 
   char *s = s48_extract_string(str);
-  int len = S48_STRING_LENGTH(str);		/* it might contain nul bytes.      */
+  int len = S48_STRING_LENGTH(str);	/* it might contain nul bytes.      */
-
+  int start = s48_extract_fixnum (_start);
+  int max_psm = s48_extract_fixnum (_max_psm);
   int vlen = S48_VECTOR_LENGTH(start_vec);
   int retval;
 
@@ -93,7 +95,7 @@ s48_value re_search(const regex_t *re, s48_value str, int start,
   if( max_psm < 10 ) pm = static_pmatch;
   else {
       pm = Malloc(regmatch_t, max_psm+1);/* Add 1 for the whole-match info. */
-      if( !pm ) return s48_enter_fixnum(-1);
+      if( !pm ) s48_raise_out_of_memory_error();
       }
   
   pm[0].rm_so = start;
@@ -105,9 +107,6 @@ s48_value re_search(const regex_t *re, s48_value str, int start,
   if( !retval && max_psm >= 0 ) { 
       int i;
 
-      //JMG:      S48_VECTOR_REF(start_vec,0) = s48_enter_fixnum(pm[0].rm_so);    /* whole-match */
-      //S48_VECTOR_REF(end_vec,0)   = s48_enter_fixnum(pm[0].rm_eo);
-
       S48_VECTOR_SET(start_vec,0, s48_enter_fixnum(pm[0].rm_so));
       S48_VECTOR_SET(end_vec,0, s48_enter_fixnum(pm[0].rm_eo));
 
@@ -117,8 +116,6 @@ s48_value re_search(const regex_t *re, s48_value str, int start,
 	      int j = s48_extract_fixnum(j_scm);
 	      int k = pm[j].rm_so,
 		  l = pm[j].rm_eo;
-	      //	JMG      S48_VECTOR_REF(start_vec,i+1) = (k != -1) ? s48_enter_fixnum(k) : S48_FALSE;
-	      //S48_VECTOR_REF(end_vec,  i+1) = (l != -1) ? s48_enter_fixnum(l) : S48_FALSE;
 	      S48_VECTOR_SET(start_vec,i+1, (k != -1) ? s48_enter_fixnum(k) : S48_FALSE);
 	      S48_VECTOR_SET(end_vec,  i+1, (l != -1) ? s48_enter_fixnum(l) : S48_FALSE);
 	  }
@@ -130,7 +127,7 @@ s48_value re_search(const regex_t *re, s48_value str, int start,
   if( retval==REG_NOMATCH ) return S48_FALSE;
   if( ! retval ) return S48_TRUE;
   return s48_enter_fixnum(retval);
-  }
+}
 
 
 
@@ -163,20 +160,34 @@ int filter_stringvec(s48_value re_str, char const **stringvec)
 
   regfree(&re);
   return q-stringvec;
-  }
+}
 
 
-const char *re_errint2str(int errcode, const regex_t *re)
+s48_value re_errint2str(s48_value _errcode, s48_value _re)
 {
+  const regex_t *re = (const regex_t *) s48_extract_integer (_re);
+  int errcode = s48_extract_fixnum (_errcode);
   int size = regerror(errcode, re, 0, 0);
   char *s = Malloc(char,size);
   if(s) regerror(errcode, re, s, size);
-  return s;
+  return s48_enter_string(s);
-  }
+}
 
 
-void free_re(regex_t *re)
+s48_value free_re(s48_value _re)
 {
+  regex_t *re = (regex_t *) s48_extract_integer(_re);
   regfree(re);
   Free(re);
-  }
+  return S48_UNSPECIFIC;
+}
+
+s48_value s48_init_re_low(void)
+{
+    S48_EXPORT_FUNCTION(compile_re);
+    S48_EXPORT_FUNCTION(re_search);
+    S48_EXPORT_FUNCTION(re_errint2str);
+    S48_EXPORT_FUNCTION(free_re);
+
+    return S48_UNSPECIFIC;
+}

scsh/rx/re1.h

@@ -1,15 +1,15 @@
 /* Exports from re1.c */
 
-int compile_re(s48_value sre, int sm_p, regex_t **cr);
+s48_value compile_re(s48_value sre, s48_value sm_p);
 
-s48_value re_search(const regex_t *re, s48_value str, int start,
+s48_value re_search(s48_value _re, s48_value str, s48_value start,
-		       s48_value trans_vec, int max_psm,
+		    s48_value trans_vec, s48_value max_psm,
-		       s48_value start_vec, s48_value end_vec);
+		    s48_value start_vec, s48_value end_vec);
 
 /* Filter a vector of strings by a regexp. */
 int filter_stringvec(s48_value re_str, char const **stringvec);
 
 /* Error code -> error msg */
-const char *re_errint2str(int errcode, const regex_t *re);
+s48_value re_errint2str(s48_value _errcode, s48_value _re);
 
-void free_re(regex_t *re);	/* Free the malloc'd regexp. */
+s48_value free_re(s48_value _re);	/* Free the malloc'd regexp. */