<<<<<<< memoize.ss
(module memoize mzscheme

  (define-syntax memo-lambda
    (syntax-rules ()
      [(_ () body0 body1 ...)
       (let* ([undefined (gensym)]
              [cached undefined])
         (lambda ()
           (when (eq? cached undefined)
             (set! cached (begin body0 body1 ...)))
           cached))]
      [(_ (arg) body0 body1 ...)
       (let ([cache (make-hash-table)])
         (lambda (arg)
           (hash-table-get cache arg (lambda ()
                                       (let ([ans (begin body0 body1 ...)])
                                         (hash-table-put! cache arg ans)
                                         ans)))))]
      [(_ (arg ...) body0 body1 ...)
       (let ([cache (make-hash-table)])
         (lambda (arg ...)
           (let* ([args (list arg ...)]
                  [key (bitwise-xor (eq-hash-code arg) ...)]
                  [alist (hash-table-get cache key (lambda () null))])
             (cond
               [(assoc args alist) => cdr]
               [else (let ([ans (begin body0 body1 ...)])
                       (hash-table-put! cache key (cons (cons args ans) alist))
                       ans)]))))]))

  (define-syntax define/memo
    (syntax-rules ()
      [(_ (name) body0 body1 ...)
       (begin
         (define undefined (gensym))
         (define cached undefined)
         (define (name)
           (when (eq? cached undefined)
             (set! cached (begin body0 body1 ...)))
           cached))]
      [(_ (name arg) body0 body1 ...)
       (begin
         (define cache (make-hash-table))
         (define (name arg)
           (hash-table-get cache arg (lambda ()
                                       (let ([ans (begin body0 body1 ...)])
                                         (hash-table-put! cache arg ans)
                                         ans)))))]
      [(_ (name arg ...) body0 body1 ...)
       (begin
         (define cache (make-hash-table))
         (define (name arg ...)
           (let* ([args (list arg ...)]
                  [key (bitwise-xor (eq-hash-code arg) ...)]
                  [alist (hash-table-get cache key (lambda () null))])
             (cond
               [(assoc args alist) => cdr]
               [else (let ([ans (begin body0 body1 ...)])
                       (hash-table-put! cache key (cons (cons args ans) alist))
                       ans)]))))]))

  (provide define/memo memo-lambda))
=======
(module memoize mzscheme

  (define undefined (gensym))

  ;; creates a local binding using LET or internal DEFINE depending on context
  (define-syntax local-declaration
    (syntax-rules (lambda define)
      [(_ lambda ([var binding]) body)
       (let ([var binding]) body)]
      [(_ define ([var binding]) body)
       (begin (define var binding) body)]))

  ;; extracts the rightmost expression from a sequence of expressions
  (define-syntax last-subexpression
    (syntax-rules ()
      [(_ (e-first ... e-last))
       e-last]))

  ;; turns a sequence of arguments into an expression that builds a list of arguments
  (define-syntax args->list
    (syntax-rules (lambda define)
      [(_ lambda (arg ...))
       (list arg ...)]
      [(_ define (name arg ...))
       (list arg ...)]))

  (define-syntax zero-arguments
    (syntax-rules ()
      [(_ define-or-lambda args body0 body1 ...)
       (local-declaration define-or-lambda ([cached undefined])
         (define-or-lambda args
           (when (eq? cached undefined)
             (set! cached (begin body0 body1 ...)))
           cached))]))

  (define-syntax one-argument
    (syntax-rules ()
      [(_ define-or-lambda args body0 body1 ...)
       (local-declaration define-or-lambda ([cache (make-hash-table)])
         (define-or-lambda args
           (hash-table-get cache
                           (last-subexpression args)
                           (lambda ()
                             (let ([ans (begin body0 body1 ...)])
                               (hash-table-put! cache (last-subexpression args) ans)
                               ans)))))]))

  (define-syntax multiple-arguments
    (syntax-rules ()
      [(_ define-or-lambda args body0 body1 ...)
       (local-declaration define-or-lambda ([cache (make-hash-table)])
         (define-or-lambda args
           (let* ([arg-list (args->list define-or-lambda args)]
                  [key (apply bitwise-xor (map eq-hash-code arg-list))]
                  [alist (hash-table-get cache key (lambda () null))])
             (cond
               [(assoc arg-list alist) => cdr]
               [else (let ([ans (begin body0 body1 ...)])
                       (hash-table-put! cache key (cons (cons arg-list ans) alist))
                       ans)]))))]))

  (define-syntax memo-lambda
    (syntax-rules ()
      [(_ () body0 body1 ...)
       (zero-arguments lambda () body0 body1 ...)]
      [(_ (arg) body0 body1 ...)
       (one-argument lambda (arg) body0 body1 ...)]
      [(_ (arg ...) body0 body1 ...)
       (multiple-arguments lambda (arg ...) body0 body1 ...)]))

  (define-syntax define/memo
    (syntax-rules ()
      [(_ (name) body0 body1 ...)
       (zero-arguments define (name) body0 body1 ...)]
      [(_ (name arg) body0 body1 ...)
       (one-argument define (name arg) body0 body1 ...)]
      [(_ (name arg ...) body0 body1 ...)
       (multiple-arguments define (name arg ...) body0 body1 ...)]))

  (provide define/memo memo-lambda))
>>>>>>> 1.3