predicate lambda

predlambda.ss

(begin-syntax
  (def (split-parg stx)
    (datum->syntax stx
      (stx-map string->symbol
               (string-split (symbol->string (stx-e stx)) #\:))))

  (def (stx-cadr stx)
    (stx-car (stx-cdr stx))))

(defsyntax (predlambda stx)
  (syntax-case stx ()
    ((macro pargs body ...)
     (with-syntax* ((split (stx-map split-parg #'pargs))
                    (args (stx-map stx-car #'split))
                    (preds (stx-map stx-cadr #'split))
                    (clauses (cons 'and (stx-map (lambda (x y) [y x]) #'args #'preds))))
       #'(lambda args
           (if clauses
             (begin body ...)))))))

(defrules defp ()
  ((_ (id . args) body ...)
   (identifier? #'id)
   (define-values (id)
     (predlambda args body ...)))
  ((_ id expr)
   (identifier? #'id)
   (define-values (id) expr)))

(defp (fun a:integer? b:integer?)
  (+ a b))

;; > (pp fun)
;; (lambda (#0=#:a499 #1=#:b500)
;;   (if (if (integer? #0#) (integer? #1#) #f) (+ #0# #1#) #!void))

(defp (fun2 a:integer?)
  (def (id x) x)
  (id a))

;; *** ERROR IN gx#core-expand-block* -- Syntax Error
;; *** ERROR IN "predlambda.ss"@38.3
;; --- Syntax Error: Bad syntax; illegal expression
;; ... form:   (begin (def (id x) x) (id a))
;; ... detail: (%#define-values (id) (lambda (x) x)) at "predlambda.ss"@38.3