(in-package :maxima) ;; uh, for now

(eval-when (:compile-toplevel :load-toplevel)
  (proclaim (optimize (speed 3)(safety 1)(space 0)  )))

;;;; -*- Mode: Lisp; Syntax: Common-Lisp -*-
;;;; Code from Paradigms of AI Programming
;;;; Copyright (c) 1991 Peter Norvig
;;; ==============================

;;;; The Memoization facility:

(defmacro defun-memo (fn args &body body)
  "Define a memoized function."
  `(memoize (defun ,fn ,args . ,body)))

(defun memo (fn &key (key #'first) (test #'eql) name)
  "Return a memo-function of fn."
  (let ((table (make-hash-table :test test)))
    (setf (get name 'memo) table)
    #'(lambda (&rest args)
        (let ((k (funcall key args)))
          (multiple-value-bind (val found-p)
              (gethash k table)
            (if found-p val
                (setf (gethash k table) (apply fn args))))))))

(defun memoize (fn-name &key (key #'first) (test #'eql))
  "Replace fn-name's global definition with a memoized version."
  (clear-memoize fn-name)
  (setf (symbol-function fn-name)
        (memo (symbol-function fn-name)
              :name fn-name :key key :test test))
  (compile fn-name);; added; compile always?
  )

(defun clear-memoize (fn-name)
  "Clear the hash table from a memo function."
  (let ((table (get fn-name 'memo)))
    (when table (clrhash table))))

;; end of norvig code

;; debugging pgm to print out memo table
(defun dmpmemoht (h)(maphash #'(lambda (k v)(format t "~%key= ~s value=~s" k v)) (get h 'memo)))

;;; now to hack Maxima..


;; make memoize work for any Maxima function "pure function" please.

(defun $memoize(r)(meval (list '($compile) r)) ;; make sure it is compiled as a lisp program
       (memoize r :key #'identity :test #'equal))

(defun $dmpmemoht(h) ;dump memo hash table
  (let  ((r (get h 'memo)))
    (if (not r)(mformat t"~%~m is not a memoized function" h)
      (maphash #'(lambda (k v)(mformat t "~%key= ~m value= ~m" `((,h),@k)  v)) r))))

(defun $clearmemoize(f) (clear-memoize f))

;; example
;; h(a,b):=sum(x^i,i,a,b)
;; memoize(h);
;; h(1,3);  --> x^3+x^2+x
;; h(1,10); --> x^10+x^9+x^8+x^7+x^6+x^5+x^4+x^3+x^2+x
;; dmpmemoht(h);
;;  key = h(1,3) value = x^3+x^2+x
;;  key= h(1,10) value= x^10+x^9+x^8+x^7+x^6+x^5+x^4+x^3+x^2+x

;; if h(a,b) takes a long time to compute, it will do so only the first time for
;; unique a,b.  After that it just looks it up in the hash table.