;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; views.ss
;;
;; Richard Cobbe
;; cobbe@ccs.neu.edu
;; Version 1.0
;; August 2006
;;
;; This module defines and exports two macros useful for creating
;; pattern-matching views.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(module views mzscheme

  (require (lib "plt-match.ss"))

  (define-match-expander view
    (lambda (stx)
      (syntax-case stx ()
        [(_ pred? ((selector pattern) ...))
         #'(? pred? (app selector pattern) ...)])))

  (define-syntax define-view
    (lambda (stx)
      (syntax-case stx ()
        [(_ view-name pred? (selector ...))
         (with-syntax ([(pattern-var ...)
                        (generate-temporaries #'(selector ...))]
                       [(pred-var) (generate-temporaries #'(pred?))]
                       [(selector-var ...)
                        (generate-temporaries #'(selector ...))])
           #'(begin
               (define pred-var pred?)
               (define selector-var selector) ...
               (define-match-expander view-name
                 (lambda (stx)
                   (syntax-case stx ()
                     [(_ pattern-var ...)
                      #'(? pred? (app selector pattern-var) ...)])))))])))

  (provide view define-view))