scsh-0.5/scsh/re1.c

/* Scheme48 interface to Henry Spencer's regular expression package.
** Copyright (c) 1993, 1994 by Olin Shivers.
*/

#include <stdlib.h>
#include "regexp.h"
#include "cstuff.h"

/* Make sure our exports match up w/the implementation: */
#include "re1.h"

/* Not multi-threaded reentrant. */
static char *regexp_error;

/* Stash error msg in global. */
void regerror(char *msg) {regexp_error = msg;}

/*
** Return NULL normally, error string on error.
** Stash number of bytes needed for compiled regexp into `*len'
*/

char *re_byte_len(const char *re, int *len)
{
    int l;

    regexp_error = 0;
    *len = regcomp_len(re); 
    return regexp_error;
    }

/*
** Return NULL normally, error string on error.
** Compile regexp into string described by `cr'.
*/

char *re_compile(const char *re, scheme_value cr) 
{
    int len = STRING_LENGTH(cr);
    regexp *r = (regexp *) &STRING_REF(cr, 0);

    regexp_error = 0;
    r = regcomp_comp(re, r, len); 
    return regexp_error;
    }

/* Return NULL normally, error string on error.
** Stash match info in start_vec and end_vec.
** Returns boolean match/no-match in hit.
*/

char *re_exec(scheme_value cr, const char *string, int start,
	      scheme_value start_vec, scheme_value end_vec,  int *hit)
{
    regexp *r = (regexp *) &STRING_REF(cr, 0);

    *hit = 0;

    if( VECTOR_LENGTH(start_vec) != NSUBEXP )	/* These tests should */
	return "Illegal start vector";		/* never trigger.     */
    if( VECTOR_LENGTH(end_vec) != NSUBEXP )
	return "Illegal end vector";

    regexp_error = 0;
    
    if( regexec(r, string+start) ) {
	int i;
	for(i=0; i<NSUBEXP; i++) {
	    const char *s = r->startp[i];
	    const char *e = r->endp[i];
	    VECTOR_REF(start_vec,i) = s ? ENTER_FIXNUM(s - string) : SCHFALSE;
	    VECTOR_REF(end_vec,i)   = e ? ENTER_FIXNUM(e - string) : SCHFALSE;
	    r->startp[i] = 0;	/* Why did Sommerfeld */
	    r->endp[i]   = 0;	/* put these here? */
	    }
	*hit = 1;
	}

    return regexp_error;
    }


char *re_subst(scheme_value cr, const char *match,
	       const char *src, int start,
	       scheme_value start_vec, scheme_value end_vec,
	       scheme_value outbuf, int *len)
{
    int i;
    regexp *r = (regexp *) &STRING_REF(cr, 0);

    if( VECTOR_LENGTH(start_vec) != NSUBEXP )	/* These tests should */
	return "Illegal start vector";		/* never trigger.     */
    if( VECTOR_LENGTH(end_vec) != NSUBEXP )
	return "Illegal end vector";

    for (i=0; i<NSUBEXP; i++) {
	scheme_value se = VECTOR_REF(start_vec, i);
	scheme_value ee = VECTOR_REF(end_vec, i);
	r->startp[i] = FIXNUMP(se) ? (match + EXTRACT_FIXNUM(se)) : 0;
	r->endp[i]   = FIXNUMP(ee) ? (match + EXTRACT_FIXNUM(ee)) : 0;
        }
    
    regexp_error = 0;
    regnsub(r, src, &STRING_REF(outbuf, 0), STRING_LENGTH(outbuf));
    *len = strlen(&STRING_REF(outbuf, 0));
    return regexp_error;
    }

char *re_subst_len(scheme_value cr, const char *match,
		   const char *src, int start,
		   scheme_value start_vec, scheme_value end_vec,
		   int *len)
{
    int i;
    regexp *r = (regexp *) &STRING_REF(cr, 0);

    if( VECTOR_LENGTH(start_vec) != NSUBEXP )	/* These tests should */
	return "Illegal start vector";		/* never trigger.     */
    if( VECTOR_LENGTH(end_vec) != NSUBEXP )
	return "Illegal end vector";

    for (i=0; i<NSUBEXP; i++) {
	scheme_value se = VECTOR_REF(start_vec, i);
	scheme_value ee = VECTOR_REF(end_vec, i);
	r->startp[i] = FIXNUMP(se) ? (match + EXTRACT_FIXNUM(se)) : 0;
	r->endp[i]   = FIXNUMP(ee) ? (match + EXTRACT_FIXNUM(ee)) : 0;
        }
    
    regexp_error = 0;
    *len = regsublen(r, src);
    return regexp_error;
    }


/* Return NULL normally, error string on error.
** Stash match info in start_vec and end_vec.
** Returns boolean match/no-match in hit.
*/

char *re_match(const char *re, const char *string, int start,
	       scheme_value start_vec, scheme_value end_vec,  int *hit)
{
    regexp *prog;

    regexp_error = 0;
    *hit = 0;
    prog = regcomp(re);
    if( !prog ) return regexp_error;

    if( VECTOR_LENGTH(start_vec) != NSUBEXP ) {	    /* These two tests */
	Free(prog);
	return "Illegal start vector";
	}
    
    if( VECTOR_LENGTH(end_vec) != NSUBEXP ) {	    /* should never trigger. */
	Free(prog);
	return "Illegal end vector";
	}

    if( regexec(prog, string+start) ) {
	int i;
	for(i=0; i<NSUBEXP; i++) {
	    const char *s = prog->startp[i];
	    const char *e = prog->endp[i];
	    VECTOR_REF(start_vec,i) = s ? ENTER_FIXNUM(s - string) : SCHFALSE;
	    VECTOR_REF(end_vec,i)   = e ? ENTER_FIXNUM(e - string) : SCHFALSE;
	    }
	*hit = 1;
	}
    
    Free(prog);
    return regexp_error;
    }


char *filter_stringvec(const char *re, char const **stringvec,  int *nummatch)
{
    regexp *prog;
    regexp_error = 0;

    if( prog=regcomp(re) ) {
	char const **p = stringvec;
	char const **q = p;

	while(*p) {
	    if( regexec(prog, *p) ) *q++ = *p;
	    p++;
	    }
	Free(prog);
	*nummatch = q-stringvec;
	}

    return regexp_error;
    }