(defmacro defmemoized (symbol lambda-list &body fnbody)
  (let ((fn (gensym))
	(mfn (gensym))
	(args (gensym))
	(sym-clear-cache (make-symbol (string-concat (symbol-name symbol) "-clear-cache")))
	(cache (make-hash-table :test #'equal)))
    (flet ((memoize (func)
	     (lambda (&rest args)
	       (multiple-value-bind (val win) (gethash args cache)
		 (if win
		     val
		     (setf (gethash args cache)
			     (apply fn args)))))))
      `(flet ((,fn ,lambda-list ,@fnbody))
	(let ((,mfn (funcall ,memoize #',fn)))
	  (defun ,symbol (&rest ,args)
	    (apply ,mfn ,args)))
	(defun ,sym-clear-cache () (clrhash ,cache) )))))

;A macro for defining functions that are cached on their parameters.
;They can be cleared or set a timeout for each individual list of arguments

(defmacro defcached (symbol lambda-list &body fnbody)
	 (let ((fn (gensym))
	       (mfn (gensym))
	       (args (gensym))
	       (cache (gensym))
	       (sym-clear-cache (intern (string-concat (symbol-name symbol) "-CLEAR-CACHE")))
	       (sym-set-timeout (intern (string-concat (symbol-name symbol) "-SET-TIMEOUT")))
	       (memoize (gensym))
	       (timeout (gensym))
	       (cache-the-val (gensym)))
	   `(let ((,cache (make-hash-table :test #'equal))
		  (,timeout nil))
	     (flet ((,memoize (func)
		      (lambda (&rest args)
			(multiple-value-bind (val in-hash) (gethash args ,cache)
			  (flet ((,cache-the-val ()
				   (car (setf (gethash args ,cache)
				    (cons (apply func args) (get-universal-time))))))
			    (if in-hash
				(if ,timeout
				    (if (> (- (get-universal-time) (cdr val)) ,timeout)
					(progn
					  (remhash args ,cache)
					  (,cache-the-val)) ;NEED TO CALL THE FUNCTION
					(progn
					  ;reset the timeout and return the val
					  (setf (gethash args ,cache)
						(cons (car val) (get-universal-time)))
					  (car val))) ;ELSE
				    (car val)) ;ELSE
				(,cache-the-val)))))))
	       (flet ((,fn ,lambda-list ,@fnbody))
		 (let ((,mfn (funcall #',memoize #',fn)))
		   (defun ,symbol ,lambda-list
		     (funcall ,mfn ,@lambda-list)))
		 (defun ,sym-clear-cache () (clrhash ,cache))
		 (defun ,sym-set-timeout (new-timeout) (setq ,timeout new-timeout)))))))



;;Test Script
(let* ((deftest '(defcached foo (x y z)
                 (sleep x)
                 (+ y z)))
      (expansion (macroexpand deftest)))
  (pprint expansion)
  (eval expansion)
  (print (time (foo 1 2 3)))
  (print (time (foo 1 2 3)))
  (foo-clear-cache)
  (foo-set-timeout 1)
  (print (time (foo 1 2 3)))
  (print (time (foo 1 2 3)))
  (sleep 2)
  (print (time (foo 1 2 3))))

(defmacro defmemoized (symbol lambda-list &body fnbody)
  (let ((fn (gensym))
	(mfn (gensym))
	(args (gensym))
	(cache (gensym))
	(sym-clear-cache (intern (string-concat (symbol-name symbol) "-CLEAR-CACHE")))
	(memoize (gensym)))
    `(let ((,cache (make-hash-table :test #'equal)))
      (flet ((,memoize (func)
	       (lambda (&rest args)
		 (multiple-value-bind (val win) (gethash args ,cache)
		   (if win
		       val
		       (setf (gethash args ,cache)
			     (apply func args)))))))
	(flet ((,fn ,lambda-list ,@fnbody))
	  (let ((,mfn (funcall #',memoize #',fn)))
	    (defun ,symbol ,lambda-list
	      (funcall ,mfn ,@lambda-list)))
	  (defun ,sym-clear-cache () (clrhash ,cache)))))))


;;Test Script

(let ((deftest '(defmemoized foo (x y z) 
		 (sleep x) 
		 (+ y z)))
      (expansion (macroexpand deftest)))
      (pprint expansion)
      (eval expansion)
      (print (time (foo 1 2 3)))
      (print (time (foo 1 2 3)))
      (foo-clear-cache)
      (print (time (foo 1 2 3))))

;;This is a final version of defmemoized macro that defines a function
;;That memoizes its variables and a function that clears the cache 
;;Example
;; (defmemoize foo (a b c) (sleep a) (+ b c))
;;  will make a function foo and a function foo-clear-cache


(defun hashish (hash key &optional value)
  (if value
      (setf (gethash key hash ) value ))
  (gethash key hash))


(defmacro defmemoized (symbol lambda-list &body fnbody)
  (let ((fn (gensym))
	(mfn (gensym))
	(args (gensym))
	(cache (gensym))
	(sym-clear-cache (intern (string-concat (symbol-name symbol) "-CLEAR-CACHE")))
	(memoize (gensym)))
    `(let ((,cache (make-hash-table :test #'equal)))
      (flet ((,memoize (func)
	       (lambda (&rest args)
		 (multiple-value-bind (val win) (gethash args ,cache)
		   (if win
		       val
		       (setf (gethash args ,cache)
			     (apply func args)))))))
	(flet ((,fn ,lambda-list ,@fnbody))
	  (let ((,mfn (funcall #',memoize #',fn)))
	    (defun ,symbol ,lambda-list
	      (funcall ,mfn ,@lambda-list)))
	  (defun ,sym-clear-cache () (clrhash ,cache)))))))



(flet ((with ( fn ) (lambda (&rest args) (apply fn args)))
       (playing ( num ) (+ 5 num)))
  (let ((mfn (funcall #'with #'playing)))
    (funcall mfn 5)))

;;Test Script

(let ((deftest '(defmemoized foo (x y z) 
		 (sleep x) 
		 (+ y z)))
      (expansion (macroexpand deftest)))
      (pprint expansion)
      (eval expansion)
      (foo 1 2 3)
      (foo 1 2 3)
      (foo-clear-cache)
      (foo 1 2 3))

;; this one works but doesnt have symbol -clear-cache doesnt work
(defmacro defmemoized (symbol lambda-list &body fnbody)
  (let ((fn (gensym))
	(mfn (gensym))
	(args (gensym))
	(cache (gensym))
	(sym-clear-cache (make-symbol (string-concat (symbol-name symbol) "-clear-cache")))
	(memoize (gensym)))
    `(let ((,cache (make-hash-table :test #'equal)))
      (flet ((,memoize (func)
	       (lambda (&rest args)
		 (multiple-value-bind (val win) (gethash args ,cache)
		   (if win
		       val
		       (setf (gethash args ,cache)
			     (apply func args)))))))
	(flet ((,fn ,lambda-list ,@fnbody))
	  (let ((,mfn (funcall #',memoize #',fn)))
	    (defun ,symbol (&rest ,args)
	      (apply ,mfn ,args)))
	  (defun ,sym-clear-cache () (clrhash ,cache) ))))))
    

;;Attempt 2 still not working

(defmacro defmemoized (symbol lambda-list &body fnbody)
  (let ((fn (gensym))
	(mfn (gensym))
	(args (gensym))
	(sym-clear-cache (make-symbol (string-concat (symbol-name symbol) "-clear-cache")))
	(cache (make-hash-table :test #'equal)))
    (flet ((memoize (func)
	     (lambda (&rest args)
	       (multiple-value-bind (val win) (gethash args cache)
		 (if win
		     val
		     (setf (gethash args cache)
			     (apply fn args)))))))
      `(flet ((,fn ,lambda-list ,@fnbody))
	(let ((,mfn (funcall #',memoize #',fn)))
	  (defun ,symbol (&rest ,args)
	    (apply ,mfn ,args)))
	(defun ,sym-clear-cache () (clrhash ,cache) )))))