82 lines
2.4 KiB
Scheme
82 lines
2.4 KiB
Scheme
;;; 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\""
|
|
"" ""
|
|
)
|
|
|
|
(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 err (error err %regexp-match regexp string start) 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.
|