(module parameter-utils mzscheme

  (require (lib "etc.ss"))
  (require-for-template (lib "plt-mzscheme.ss" "lang"))
  (require-for-syntax
   (lib "etc.ss")
   (planet "syntax-utils.ss" ("cce" "syntax-utils.plt" 1 (= 0))))

  (provide param-lambda)

  (define-syntax (param-lambda stx)

    (define (process-param-args stx args)
      (recur next-arg ([args args]
                       [id-args null]
                       [opt-args null]
                       [param-args null])
        (syntax-case-by-name args (=>)
          [ID
           (identifier? #'ID)
           #`((#,@(reverse id-args))
              (#,@(reverse opt-args))
              (#,@(reverse param-args))
              ID)]
          [()
           #`((#,@(reverse id-args))
              (#,@(reverse opt-args))
              (#,@(reverse param-args))
              ())]
          [(ID . REST)
           (identifier? #'ID)
           (if (null? opt-args)
               (next-arg #'REST (cons #'ID id-args) opt-args param-args)
               (raise-syntax-error #f "argument needs default" stx #'ID))]
          [([ID EXPR] . REST)
           (identifier? #'ID)
           (next-arg #'REST id-args (cons #'[ID EXPR] opt-args) param-args)]
          [([ID => EXPR] . REST)
           (next-arg #'REST id-args
                     (cons #'[ID (EXPR)] opt-args)
                     (cons #'[ID EXPR] param-args))])))

    (syntax-case stx ()
      [(_ ARGS BODY MORE ...)
       (with-syntax ([((ID-ARG ...)
                       ([OPT-ARG DEFAULT] ...)
                       ([PARAM-ARG PARAM] ...)
                       REST-ARG)
                      (process-param-args stx #'ARGS)])
         #'(opt-lambda (ID-ARG ... [OPT-ARG DEFAULT] ... . REST-ARG)
             (parameterize ([PARAM PARAM-ARG] ...)
               BODY MORE ...)))]))

  )