;; -*- Scheme -*-
;;
;; $Id: string59.scm,v 1.1 1998/03/16 08:00:04 foner Exp $

(require 'string:search)

;;+doc
;; procedure: string:case:pattern/action
;; arguments: pattern action[arg ...]
;; signature: forall a => pattern x ((exists b => b) ... -> a) -> a   XXX?
;;
;; Create a PATTERN/ACTION pair.
;;-doc

(define string:case:pattern/action
  (lambda (pattern action)
    (lambda (string next-pattern/action)
      (let* ((yes (lambda (_ . r) (apply action r)))
	     (no (lambda (_) (next-pattern/action))))
	(apply string:search string yes no pattern)))))


;;+doc
;; procedure: string:case:pattern
;; arguments: pattern ...
;;
;; Construct a STRING:CASE pattern out of PATTERN ...
;; For example, the following constructs a pattern that will match
;; the regular expression "#[\t ]*include" :-
;;
;; > (string:case:pattern (match #\#) (skip* ws) (match "include"))
;;
;; where match = string:search:match, skip* = string:search:skip*
;;-doc

(define string:case:pattern list)


(define string:case::helper
  (lambda (string pattern/actions)
    (let ((next-pattern/action
	   (lambda ()
	     (string:case::helper string (cdr pattern/actions)))))
      (if (null? pattern/actions)
	  #f
	  ((car pattern/actions) string next-pattern/action)))))

;;+doc
;; procedure: string:case
;; arguments: pattern/action ...
;;
;;
;; (string:case string
;;   (string:case:pattern/action 
;;     (string:case:pattern (string:search:match "-I") string:search:save-pos)
;;     (lambda (pos) (display "found a -I at ") (display pos) (newline)))
;;   (string:case:pattern/action
;;     (string:case:pattern (string:search:match "-D") string:search:save-pos)
;;     (lambda (pos) (display "found a -D at ") (display pos) (newline))))
;;-doc

(define string:case
  (lambda (string . pattern/actions)
    (string:case::helper string pattern/actions)))

;; eof
