scsh-0.5/scsh/re.scm

83 lines
2.4 KiB
Scheme
Raw Normal View History

1995-10-13 23:34:21 -04:00
;;; Regular expression matching for scsh
;;; Copyright (c) 1994 by Olin Shivers.
(foreign-source
"/* Make sure foreign-function stubs interface to the C funs correctly: */"
"#include \"re1.h\""
"" ""
)
1995-10-13 23:34:21 -04:00
(define-record regexp-match
string
start ; 10 elt vec
end) ; 10 elt vec
;;; Need to do error case for these three procs.
(define (match:start match . maybe-index)
(vector-ref (regexp-match:start match)
(optional-arg maybe-index 0)))
(define (match:end match . maybe-index)
(vector-ref (regexp-match:end match)
(optional-arg maybe-index 0)))
(define (match:substring match . maybe-index)
(let ((i (optional-arg maybe-index 0)))
(substring (regexp-match:string match)
(match:start match i)
(match:end match i))))
(define (string-match pattern string . maybe-start)
(apply regexp-exec (make-regexp pattern) string maybe-start))
;;; Bogus stub definitions for low-level match routines:
(define regexp? string?)
(define (make-regexp str) str)
(define (regexp-exec regexp str . maybe-start)
(let ((start (optional-arg maybe-start 0))
(start-vec (make-vector 10))
(end-vec (make-vector 10)))
(and (%regexp-match regexp str start start-vec end-vec)
(make-regexp-match str start-vec end-vec))))
;;; Convert a string into a regex pattern that matches that string exactly --
;;; in other words, quote the special chars with backslashes.
(define (regexp-quote string)
(let lp ((i (- (string-length string) 1))
(result '()))
(if (< i 0) (list->string result)
(lp (- i 1)
(let* ((c (string-ref string i))
(result (cons c result)))
(if (memv c '(#\[ #\] #\. #\* #\? #\( #\) #\| #\\ #\$ #\^ #\+))
(cons #\\ result)
result))))))
(define-foreign %regexp-match/errno (reg_match (string regexp)
(string s)
(integer start)
(vector-desc start-vec)
(vector-desc end-vec))
static-string ; Error string or #f if all is ok.
bool) ; match?
(define (%regexp-match regexp string start start-vec end-vec)
(receive (err match?) (%regexp-match/errno regexp string start
start-vec end-vec)
(if (not (equal? err "")) (error err %regexp-match)
match?)))
;;; I do this one in C, I'm not sure why:
;;; Used by MATCH-FILES.
(define-foreign %filter-C-strings!
(filter_stringvec (string regexp) ((C "char const ** ~a") cvec))
static-string ; error message -- #f if no error.
integer) ; number of files that pass the filter.