68 lines
2.0 KiB
Scheme
68 lines
2.0 KiB
Scheme
|
;;; Regular expression matching for scsh
|
||
|
|
;;; Copyright (c) 1994 by Olin Shivers.
|
||
|
|
|
||
|
|
(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?)))
|