(in-package "JVM")

(unless (equal (LISP-IMPLEMENTATION-VERSION) "0.0.10.3") ; triggers some horrible bug (aren't they all)
  (defun rewrite-function-call (form)
    (let ((args (cdr form)))
      (if (unsafe-p args)
	  (let ((arg1 (car args)))
	    (cond ((and (consp arg1) (eq (car arg1) 'GO))
		   arg1)
		  (t
		   (let ((syms ())
			 (lets ()))
		     ;; Preserve the order of evaluation of the arguments!
		     (dolist (arg args)
		       (cond ((constantp arg)
			      (push arg syms))
			     ((and (consp arg) (eq (car arg) 'GO))
			      (return-from rewrite-function-call
				(list 'LET* (nreverse lets) arg)))
			     (t
			      (let ((sym (gensym)))
				(push sym syms)
				(push (list sym arg) lets)))))
		     (list 'LET* (nreverse lets)
			   (list* (car form) (nreverse syms)))))))
	  (maybe-lambda->let form)
	  )))

  ;; transform ([funcall] (lambda(a b [&rest c]) ...) p q [r s ...]) -> (let ((a p) (b q) (c (list r s ...))) ...)
  (defun maybe-lambda->let (form)
    (if (or (and (consp (car form))
		 (eq (caar form) 'lambda))
	    (and (eq (car form) 'funcall)
		 (consp (second form))
		 (eq (car (second form)) 'lambda)))
	(let* ((lambda (if (eq (car form) 'funcall) (second form) (car form)))
	       (args (if (eq (car form) 'funcall) (cddr form) (cdr form)))
	       (lambda-list (second lambda))
	       (lambda-forms (cddr lambda)))
	  (if (or (member '&aux lambda-list :test #'eq)
		  (member '&key lambda-list :test #'eq)
		  (member '&optional lambda-list :test #'eq))
	      form			; punt
	      ;; if there is a &rest arg then transform that, as long as we have enough args to satisfy the non rest-args
	      (if (and (eql (position '&rest lambda-list) (- (length lambda-list) 2))
		       (>= (length args) (- (length lambda-list) 2)))
		  (let ((rest-form (if (> (length args)  (- (length lambda-list) 2))
				       `(list ,@(subseq args (- (length lambda-list) 2))))))
		    `(let ,(append (mapcar 'list (subseq lambda-list 0 (- (length lambda-list) 2)) args)
				   `((,(car (last lambda-list)) ,rest-form)))
		       ,@lambda-forms))
		  ;; if we don't have &rest and the number of args matches the number of args in the lambda list then simple
		  (if (and (not (member '&rest lambda-list :test #'eq))
			   (= (length lambda-list) (length args)))
		      `(let ,(mapcar 'list lambda-list args)
			 ,@lambda-forms)
		      form ;; otherwise punt
		      ))))
	form)))


(defun lvd-restarg ()
  (declare (optimize (speed 3) (safety 0)))
  (let* ((a1 (random 100))
	 (b1 (1+ a1))
	 (c1 (1+ b1))
	 (d1 (1+ c1)))
    (flet ((bar (x y z) (setq s (+ x y (car z) (second z)) )))
      (time (dotimes (i 200000) ((lambda (a b &rest c &aux) (bar a b c))  a1 b1 c1 d1)))
      (time (dotimes (i 200000) ((lambda (a b &rest c) (bar a b c))  a1 b1 c1 d1)))
      (time (dotimes (i 200000) (destructuring-bind (a b &rest c) (list a1 b1 c1 d1) (bar a b c)))))
    ))

(defun lvd-no-restarg () 
  (declare (optimize (speed 3) (safety 0)))
  (let* ((v1 (random 100))
	 (v2 (1+ v1))
	 (v3 (1+ v2))
	 (args (list v1 v2 :c v3))
	 (s nil))
    (time (setq s (dotimes (i 200000)
		    ((lambda (a &optional (b 2 b-supplied) &key (c 2)) (if b-supplied (+ a b c))) v1  v2 :c v3))))
    (time (setq s (dotimes (i 200000)
		    (destructuring-bind (a &optional (b 2 b-supplied) &key (c 2)) args (+ a b c)))))
    ))