Ported to new FFI.
This commit is contained in:
parent
949d50fbbe
commit
1ea7c8604e
|
@ -203,6 +203,7 @@
|
|||
ascii
|
||||
primitives ; JMG add-finalizer!
|
||||
define-record-types ; JMG debugging
|
||||
external-calls
|
||||
string-lib ; string-fold
|
||||
scheme)
|
||||
|
||||
|
|
|
@ -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?)
|
||||
(if (zero? errcode) c-struct
|
||||
(error errcode (%regerror-msg errcode c-struct)
|
||||
compile-posix-re->c-struct re-string sm?))))
|
||||
|
||||
(define-foreign %compile-re (compile_re (string-desc pattern) (bool submatches?))
|
||||
integer ; 0 or error code
|
||||
(C regex_t*))
|
||||
(let ((maybe-struct (%compile-re re-string sm?)))
|
||||
(if (pair? maybe-struct)
|
||||
(error (car maybe-struct)
|
||||
(%regerror-msg (car maybe-struct) (cdr maybe-struct))
|
||||
compile-posix-re->c-struct re-string sm?)
|
||||
maybe-struct)))
|
||||
|
||||
;;; 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
|
||||
(re_search ((C "const regex_t *~a") compiled-regexp)
|
||||
(string-desc str)
|
||||
(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.
|
||||
; 0 success, #f no-match, or non-zero int error code:
|
||||
(define-stubless-foreign %cre-search
|
||||
(compiled-regexp str start tvec max-psm svec evec) "re_search")
|
||||
|
||||
|
||||
|
||||
;;; Generate an error msg from an error code.
|
||||
|
||||
(define-foreign %regerror-msg (re_errint2str (integer errcode)
|
||||
((C "const regex_t *~a") re))
|
||||
string)
|
||||
(define-stubless-foreign %regerror-msg (errcode re) "re_errint2str")
|
||||
|
||||
|
||||
;;; 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")))
|
||||
|
||||
|
|
|
@ -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 err;
|
||||
regex_t *re = Alloc(regex_t);
|
||||
|
||||
if( !re ) return -1;
|
||||
|
||||
re->re_endp = s + len;
|
||||
err = regcomp(re, s, REG_EXTENDED | REG_PEND
|
||||
| (sm_p ? 0 : REG_NOSUB));
|
||||
if( err ) {Free(re); *cr=0;}
|
||||
else *cr=re;
|
||||
|
||||
return err;
|
||||
}
|
||||
int len = S48_STRING_LENGTH(re_str);
|
||||
int err;
|
||||
regex_t *re = Alloc(regex_t);
|
||||
|
||||
if( !re ) s48_raise_out_of_memory_error();
|
||||
|
||||
re->re_endp = s + len;
|
||||
err = regcomp(re, s, REG_EXTENDED | REG_PEND
|
||||
| ((sm_p != S48_FALSE) ? 0 : REG_NOSUB));
|
||||
if( err ) {
|
||||
Free(re);
|
||||
return s48_cons(s48_enter_fixnum (err), s48_enter_fixnum (0));
|
||||
}
|
||||
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 trans_vec, int max_psm,
|
||||
s48_value re_search(s48_value _re, s48_value str, s48_value _start,
|
||||
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;
|
||||
}
|
||||
|
|
|
@ -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 trans_vec, int max_psm,
|
||||
s48_value start_vec, s48_value end_vec);
|
||||
s48_value re_search(s48_value _re, s48_value str, s48_value start,
|
||||
s48_value trans_vec, s48_value max_psm,
|
||||
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. */
|
||||
|
|
Loading…
Reference in New Issue