;(load "load")

;;; Problem 6.5

; note: I commented out the rule-memoize line from "load.scm" so I can define
; that procedure here then reload the algebra stuff

(define *memoize-table* '())

; this will make a lazy table with n elements
(define (make-table n)
  (define (recurse n)
    (cond ((zero? n) '())
	  (else (cons '() (recurse (- n 1))))))
  (cons '*finite-table* (recurse n)))

(define (bring-to-front! x y table)
  (set-cdr! table
	    (cons (list x y) 
		  (list-transform-negative 
		      (cdr table)
		    (lambda (element)
		      (and (not (null? element))
			   (equal? x (car element))))))))

(define (insert! x y table)
  (set-cdr! table
	    (cons (list x y) 
		  (except-last-pair (cdr table)))))

(define (lookup x table)
  (define (recurse list)
    (cond ((null? list) '())
	  ((null? (car list)) '())
	  ((equal? x (car (car list))) 
	   (let ((res (car (cdr (car list)))))
	     (bring-to-front! x res table)
	     res))
	  (else (recurse (cdr list)))))
  (recurse (cdr table)))

#| Test
(define tt (make-table 6))
(insert! 'asdf 3 tt)
(insert! '(+ 1 2) #f tt)
tt
;Value 21: (*finite-table ((+ 1 2) #f) (asdf 3) ())
(lookup 'asdf tt)
; 3
tt
;Value 27: (*finite-table (asdf 3) ((+ 1 2) #f) () () () ())
(lookup 'wacky tt)
; '()
(lookup '(+ 1 2) tt)
; #f

|#

(set! *memoize-table* (make-table 25))

(define (rule-memoize f)
  (lambda (expr)
    (let ((table *memoize-table*))
      (let ((last-result (lookup expr table)))
	(cond
	 ((null? last-result)
	  (let ((this-result (f expr)))
	    (insert! expr this-result table)
	    this-result))
	 (else last-result))))))

#| TEST IT OUT!

(pp (algebra-2 '(+ x x x)))
; (+ x x x)

(algebra-2 '(+ 4 5 (* 3 4) x))
; (+ 21 x)

(algebra-2 '(* 34 8 (+ 4 5 (* 3 4) x) x))

|#

; but as noted in SICP this isn't really what we want, we need to 
; override rule-simplifier so simplify-expression calls 
; (rule-memoize simplified-expression). Otherwise we're only memoizing
; the application of entire expressions, not recursively through the
; subexpressions which is where this gets useful.

(define (rule-simplifier the-rules)
  (define memo-simplify-expression
    (rule-memoize
     (lambda (expression)
       (let ((ssubs
	      (if (list? expression)
		  (map memo-simplify-expression expression)
		  expression)))
	 (let ((result (try-rules ssubs the-rules)))
	   (if result
	       (memo-simplify-expression result)
	       ssubs))))))
  memo-simplify-expression)

(load "rules")

#| TEST IT OUT!

(pp (algebra-2 '(+ x x x)))
; (+ x x x)

(algebra-2 '(+ 4 5 (* 3 4) x))
; (+ 21 x)

(algebra-2 '(* 34 8 (+ 4 5 (* 3 4) x) x))
;Value 13: (* 272 x (+ 21 x))

*memoize-table*
;Value 12: (*finite-table* 
((* 34 8 (+ 4 5 (* 3 4) x) x) (* 272 x (+ 21 x))) 
((+ 4 5 (* 3 4) x) (+ 21 x)) 
((+ x x x) (+ x x x)) 
((* 8 34 (+ 21 x) x) (* 272 x (+ 21 x))) 
((* 8 34 x (+ 21 x)) (* 272 x (+ 21 x))) 
((* 272 x (+ 21 x)) (* 272 x (+ 21 x))) 
((+ 21 x) (+ 21 x)) 
(x x) 
(272 272) 
(* *) 
(34 34) 
(8 8) 
(+ +) 
((+ 9 12 x) (+ 21 x)) 
(21 21) 
(12 12) 
(9 9) 
((* 3 4) 12) 
((* 12) 12) 
(4 4) 
(3 3) 
(5 5) 
() () ())

; hmmmm, maybe don't want to memoize /every/ little thing?
|#