(define-module (language python def)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-11)
  #:export (def lam))

(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-rule (take-1 ww* kw s v)
  (if (null? ww*)
      (values ww*
              (aif it (hash-ref kw s #f)
                   (begin
                     (hash-remove! kw s)
                     it)
                   v))
      (begin
        (hash-remove! kw s)
        (values (cdr ww*) (car ww*)))))

(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) kw))
      (()
       (values (reverse args) kw)))))

(define hset! hash-set!)

(define (pytonize kw)
  (hash-fold
   (lambda (k v h)
     (hset! h (symbol->string (keyword->symbol k)) v)
     h)
   (make-hash-table)
   kw))

(define-syntax lam
  (lambda (x)
    (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)))
    
    (syntax-case x ()
      ((_ (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))
             #`(lambda #,as code ...)
             (with-syntax ((kw      (if (null? kw)
                                        (datum->syntax x (gensym "kw"))
                                        (car kw)))
                           (ww      (if (null? ww)
                                        (datum->syntax x (gensym "ww"))
                                        (car ww)))
                           ((k ...) (map car kv))
                           ((s ...) (map ->kw (map car kv)))
                           ((v ...) (map cdr kv)))
              #`(lambda* (#,@as . l)                     
                   (call-with-values (lambda () (get-akw l))
                     (lambda (ww* kw)
                       (let*-values (((ww* k) (take-1 ww* kw s v))
                                     ...)
                         (let ((ww ww*)
                               (kw (pytonize kw)))
                           code ...))))))))))))

(define-syntax-rule (def (f . args) code ...) (define f (lam args code ...)))