;;; A Fast pattern matching procedure (but not as flexible as MATCH).
;;; S. Tanimoto.  Oct 21, 2002.
;;; Assumes the pattern contains only literals and (+ x) forms,
;;; and any two (+ x) forms are separated by at least one literal.
;;; e.g., (GREEDY-MATCH '(IF (+ X) AND (+ Y) THEN (+ Z))
;;;                     '(IF THE AREA OF A CIRCLE IS PI TIMES THE SQUARE OF THE RADIUS
;;;                           AND THE RADIUS IS 10 METERS THEN WHAT IS THE AREA OF THE CIRCLE ?) )
;;; returns the binding list
;;; ((x the area of a circle is pi times the square of the radius)
;;;  (y the radius is 10 meters)
;;;  (z what is the area of the circle ?) )

;;; Here the construct (+ X) matches one or more elements in the subject.
;;; If it is followed by an atom (usually a symbol or number) in the pattern,
;;; then it matches up to but not including the next occurrence of that atom
;;; in the subject.

(define (greedy-match p s)
  (cond ((null? p)(if (null? s) () #f))
        ((and (atom? (car p))(pair? s)(equal? (car p)(car s))) (greedy-match (cdr p)(cdr s)))
        ((and (pair? (car p)) (eq? (caar p) '+))
         (if (and (pair? (cdr p)) (atom? (cadr p)))
             ; match everything up to the next occurrence of (cadr p) in S.
             (let ((b (match-to-and-from (cadr p) (cddr p) s)))
               (if b (cons (cons (cadar p)(car b)) (cdr b)) #f) )
             (if (null? (cdr p))
             ; match all the rest of S
                 (list (cons (cadar p) s))
                 ;(let ((b (greedy-match (cdr p)(cdr s))))
                 ;  (if b (cons (cons (cadar p) (car b)) (cdr b)) #f) )
                 #f) ) )
        (#t #f) )
  )

(define (match-to-and-from literal p s)
  (if (pair? s)
      (if (equal? literal (car s)) 
          (cons () (greedy-match p (cdr s)))
          (let ((rest-match (match-to-and-from literal p (cdr s))))
            (if rest-match
                (cons (cons (car s)(car rest-match)) (cdr rest-match))
                #f) ) )
                
      #f)
  )
                
 (define (atom? x) (not (pair? x)))