Общая процедура memoization в схеме

Question

Я пытаюсь создать общую процедуру memoization в Схеме. Это то, что я до сих пор (это почти полностью же, как и физические упражнения 3.27 в книге SICP):

(define (memo proc) 
    (let ((table (make-table))) 
    (lambda (args) 
     (let ((prev (lookup args table))) 
     (or prev 
      (let ((result (proc args))) 
       (insert! args result table) 
       result)))))) 

(The «сделать стол», «вставить!» И процедуры «подстановки» определены в SICP book)

Если я вызываю этот метод процедурой, которая принимает только один аргумент, она работает нормально. То, что я не могу понять, как это сделать, - заставить его работать с процедурой, которая принимает 0 или несколько аргументов.

Я нашел эту ссылку: http://community.schemewiki.org/?memoization, но я все еще не могу заставить ее работать. В процедуре в ссылке используются значения и значения call-with-values, и хотя я получил приблизительное представление о том, как они работают, я не могу интегрировать его с моей процедурой.

(define (mem2 proc) 
    (let ((table (make-table))) 
     (lambda args 
      (let ((prev (lookup args table))) 
      (or prev 
       (call-with-values 
       (lambda() (apply proc args)) 
       (lambda (result) 
        (insert! args result table) 
        result))))))) 

Это моя попытка выполнить процедуру по ссылке, используя список. Он почти работает, но если у меня есть процедура, которая принимает несколько аргументов, она будет вычислять ее несколько раз. Скажем, я передаю случайную процедуру аргументам 1 2 3 4. Это спасет 1 2 3 4 в таблице, но не данные результаты для 1, 2, 3 и 4 отдельно. Я предполагаю, что моя ошибка - это то, где я выполняю поиск, поскольку я передаю весь список сразу.

EDIT: добавлена ​​процедура проверки, что mem2 работает некорректно.

(define (add . args) 
    (display "computing add of ") 
    (display args) (newline) 
    (if (null? args) 
     0 
     (+ (car args) (apply add (cdr args))))) 

Он сохранит в таблице поиска все «аргументы». Так что, если у меня есть:

(определить надстройку (mem2 добавить))

(добавить 2 3 4)

вычислительное надстройку из (2 3 4)

вычислительном оных (3 4)

вычислений добавить из (4)

(добавить 3)

вычислительное надстройку (3)

Answer 1

(define (make-table) 
    (vector '())) 

(define (insert! key val t) 
    (vector-set! t 0 (cons (cons key val) (vector-ref t 0)))) 

(define (lookup key t) 
    (let ([result (assoc key (vector-ref t 0))]) 
    (and result (cdr result)))) 

(define (mem2 proc) 
    (let ((table (make-table))) 
    (lambda args 
     (let ((prev (lookup args table))) 
     (or prev 
      (let ([result (apply proc args)]) 
       (insert! args result table) 
       result)))))) 

(define (plus x y) 
    (display (list "Computing sum of: " x y)) 
    (newline) 
    (+ 1 2)) 

(define memo-plus (mem2 plus)) 

(memo-plus 1 2) 
(memo-plus 1 2) 

Выход:

(Computing sum of: 1 2) 
3 
3 

Добавление:

(define (add . args) 
    (display "computing add of ") 
    (display args) (newline) 
    (if (null? args) 
     0 
     (+ (car args) (apply add (cdr args))))) 

(define memo-add (mem2 add)) 

(memo-add 1 2 3 4) 
(memo-add 1 2 3 4) 

дает выход:

computing add of (1 2 3 4) 
computing add of (2 3 4) 
computing add of (3 4) 
computing add of (4) 
computing add of() 
10 
10 

Поскольку ничего не было напечатано до последних 10, пример показывает, что результат был замечен.