(define-module (language python def)
  #:export (def))

(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
(define (fold lam s l)
  (if (pair? l)
      (lam (car l) (fold lam s (cdr l)))
      s))


(define-syntax def
  (lambda (x)
    (define (get-akw l)
      (let lp ((l l) (args '()) (kw (make-hash-table)))
        (match l
          (((? keyword? k) v . l)
           (hash-set! kw k v)
           (lp l args kw))
          ((x . l)
           (lp l (cons x args) k))
          (()
           (values (reverse args) kw)))))

    (define-syntax-rule (mk get-as (k v s) x y z w)
      (define get-as
        (lambda (a s)
          (syntax-case a (= * **)
            ((= k v) #'x)
            ((**  k) #'y)
            ((*   k) #'z)          
            (k       #'w)))))

    (mk get-as (k v s)  s                    s           s           (cons k s))
    (mk get-kw (k v s)  s                    (cons k s)  s           s         )
    (mk get-ww (k v s)  s                    s           (cons k s)  s         )
    (mk get-kv (k v s)  (cons (cons k v) s)  s           s           s         )

    (define (->kw x) (symbol->keyword (syntax->datum x)))

    (define-syntax-rule (take-1 ww* kw s v)
      (if (null? ww*)
          (values ww*
                  (aif it (hash-ref kw s #f)
                       (begin
                         (remove-hash! kw s)
                         it)
                       v))
          (begin
            (remove-hash! kw s)
            (values (cdr ww) (car ww)))))
    
    (syntax-case x ()
      ((_ f (arg ...) code ...)
       (let* ((as  (fold get-as '() #'(arg ...)))
              (kw  (fold get-kw '() #'(arg ...)))
              (ww  (fold get-ww '() #'(arg ...)))
              (kv  (fold get-kv '() #'(arg ...))))
         (if (and-map null? (list kw ww kv))
             #`(define f (lambda #,as code ....))
             (with-syntax ((l       (datum->syntax #'f  (gensym "l")))
                           (kw      (if (null? kw)
                                        (datum->syntax #'f (gensym "kw"))
                                        (car kw)))
                           (ww      (if (null? ww)
                                        (datum->syntax #'f (gensym "ww"))
                                        (car ww)))                           
                           ((k ...) (map car kv))
                           ((s ...) (map ->kw (map car kv)))
                           ((v ...) (map cdr kv)))
               #`(define f                   
                   (lambda* (#,@as . l)                     
                     (call-with-values (get-akv l)
                       (lambda (ww* kw)
                         (let-values* (((ww* k) (take-1 ww* kw s v))
                                       ...)
                           (let ((ww ww*))
                             code ...)))))))))))))