(define-module (language python def)
  #:use-module (oop pf-objects)
  #:use-module (language python for)
  #:use-module (language python list)
  #:use-module (language python exceptions)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-11)
  #:export (def lam py-apply))

(define e (list 'error))
(define-syntax-rule (aif it p x y) (let ((it p)) (if (not (eq? it e)) x y)))
(define (fold lam s l)
  (if (pair? l)
      (lam (car l) (fold lam s (cdr l)))
      s))

(define-syntax-rule (take-1 pww ww* kw s v)
  (if (not pww)
      (values ww*
              (aif it (hash-ref kw s e)
                   (begin
                     (hash-remove! kw s)
                     it)
                   v))
      (if (pair? ww*)
          (begin
            (hash-remove! kw s)
            (values (cdr ww*) (car ww*)))
          (values ww*
                  (aif it (hash-ref kw s e)
                       (begin
                         (hash-remove! kw s)
                         it)
                       v)))))
                       

(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))
             #`(object-method
                (lambda (#,@as . u12345678)
                  (if (and (pair? u12345678)
                           (not (keyword? (car u12345678))))
                      (raise  (ArgumentError "too many arguments to function")))
                  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)))
	      #`(object-method
		 (lambda* (#,@as . l)                     
		  (call-with-values (lambda () (get-akw l))
		    (lambda (ww* kw)
		      (let*-values (((ww* k) (take-1 #,(null? ww-) ww* kw s v))
				...)
			(let ((ww ww*)
			      (kw (pytonize kw)))
			  code ...)))))))))))))

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


(define (no x)
  (and-map
   (lambda (x)
     (syntax-case x (* ** =)
       ((*  _)  #f)
       ((** _)  #f)
       ((= a b) #f)
       (_ #t)))
   x))

(define (mk-k x)
  (if (keyword? x)
      x
      (symbol->keyword
       (if (string? x)
	   (string->symbol x)
	   x))))

(define-syntax m*
  (syntax-rules (* ** =)
    ((_ (=  a b))
     (list (symbol->keyword 'a) b))
    ((_ (*  a)) a)
    ((_ (** kw))
     (for ((k v : kw)) ((l '()))
       (cons* v (mk-k k) l)
       #:final (reverse l)))
    ((_ a) (list a))))

(define-syntax py-apply  
  (lambda (x)
    (syntax-case x ()
      ((_ f a ... (op x))
       (and (syntax-case #'op (*)
              (* #t)
              (_ #f))
            (and-map (lambda (q)
                       (syntax-case q (* ** =)
                         ((=  _ _) #f)
                         ((*  _  ) #f)
                         ((** _  ) #f)
                         (_    #t))) #'(a ...)))
       #'(if (or (null? x) (pair? x))
             (apply f a ... x)
             (apply f a ... (to-list x))))

      ((_ f a ...)
       (if (no #'(a ...))
	   #'(f a ...)
	   #'(apply f (let lp ((l (list (m* a) ...)))
			(if (pair? l)
			    (append (to-list (car l)) (lp (cdr l)))
			    '()))))))))