pdefine   scheme

(has-number? '(a b c d e))
;Value: #f
|#
;; </pre>
;; <b>Note</b>: Functions created using c{pdefine} are bound in c{user-initial-environment}.
(define-syntax pdefine
  (er-macro-transformer
   (lambda (expr rename compare)
     (let* ((name     (car (second expr)))
            (patterns (cdr (second expr)))
            (body     (cddr expr))
            (predicates (map (lambda (pattern)
                               `(curry p:matches? ,(list 'quasiquote pattern)))
                             patterns)))
       `(begin
          ; register new generic operator if this is the first definition
          ; of the function
          (cond ((not (default-on-error #f (lambda () (pattern-procedure? ,name))))
                 (environment-define
                  user-initial-environment
                  (quote ,name)
                  (genop:make (quote ,name) ,(length patterns)
                              (lambda args
                                (error ,(string-append "Non-exhaustive patterns in function "
                                                       (symbol->string name))))))
                 (note:attach! ,name (quote is-pattern-procedure) #t)))