#lang scheme/base
(require (for-syntax scheme/base) 
         (planet bzlib/base))

;; convert an argument (and an optional argument) into an identifier
;; p => p
;; (p v ...) => p
(define (arg->identifier stx)
  (syntax-case stx ()
    (p
     (symbol? (syntax->datum #'p))
     #'p)
    ;; an optional arg.
    ((p . _)
     #'p)))

;; (a (b v1) #:c (c v2)) => (a b #:c c)
(define (args->identifiers stx)
  (syntax-case stx () 
    (()
     #'())
    ((p . rest)
     (keyword? (syntax->datum #'p))
     #`(p . #,(args->identifiers #'rest)))
    ((p . rest)
     #`(#,(arg->identifier #'p) . #,(args->identifiers #'rest)))))

(define (args->kw-identifiers stx)
  (syntax-case stx () 
    (()
     #'())
    ((p . rest) 
     (keyword? (syntax->datum #'p))
     #`(p . #,(args->identifiers #'rest)))
    ((p . rest)
     (args->kw-identifiers #'rest))))
;; (trace args->kw-identifiers)

(define (args->kw-args stx)
  (syntax-case stx () 
    (() 
     #'())
    ((p . rest)
     (keyword? (syntax->datum #'p))
     #'(p . rest))
    ((p . rest)
     (args->kw-args #'rest))))

(define (args->non-kw-identifiers stx)
  (syntax-case stx () 
    (()
     #'())
    ((p . rest)
     (keyword? (syntax->datum #'p))
     #'())
    ((p . rest)
     #`(#,(arg->identifier #'p) . #,(args->non-kw-identifiers #'rest)))))

(define (args->non-kw-args stx)
  (syntax-case stx () 
    (()
     #'())
    ((p . rest)
     (keyword? (syntax->datum #'p))
     #'())
    ((p . rest)
     #`(p . #,(args->non-kw-args #'rest)))))

(provide arg->identifier 
         args->identifiers 
         args->kw-identifiers 
         args->non-kw-identifiers
         args->kw-args 
         args->non-kw-args
         )