scsh-0.5/scsh/re.scm

;;; 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 (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.