(defun fib (n)
    (if (<= n 1) 1 (+ (fib (- n 1)) (fib (- n 2)))))

(defun fib (n &optional (c 1) (p 0))  ;; рекурсия
   (if (zerop n) c (fib (- n 1) (+ c p) c)))
 
(defun fib (n) ;; итерация
  (let ((c 1)
           (p 0)
           (tmp 0))
    (dotimes (i n c)
      (setq tmp (+ c p) p c c tmp))))

(let ((asso nil))
   (defun fib (n)
    (if (<= n 1) 1 (+ (fib (- n 1)) (fib (- n 2))))))

(fib 5)
==> 8

(context 'fib)
==> ((ASSO NIL))

(let ((asso nil))
  (defun fib (n) 
      (let ((tmp (assoc n asso)))
          (if tmp (cdr tmp)
              (let ((r (if (<= n 1) 1 (+ (fib (- n 1)) (fib (- n 2))))))
                     (push (cons n r) asso) r)))))

(fib 10)
==> 89

(context 'fib)
==> ((ASSO ((10 . 89) (9 . 55) (8 . 34) (7 . 21) (6 . 13) (5 . 8) (4 . 5) (3 . 3)
            (2 . 2) (0 . 1) (1 . 1))))

(defun fib (n)
   (if (<= n 2) 1 (+ (fib (- n 1)) (fib (- n 2)))))
 
(getd 'fib)
==> (EXPR (N) (IF (<= N 2) 1 (+ (FIB (- N 1)) (FIB (- N 2)))))

(defmacro memoize (f)
  (let ((body (cdr (getd f)))
           (parm (cadr (getd f)))) ...

(defmacro memoize (f)
  (let ((body (cdr (getd f)))
(parm (cadr (getd f))))
      `(let ((asso nil)) ...

(let ((a 111))
  `(a ,a))
 
==> (A 111)

(let ((a '(1 1 1)))
  `(a ,a))
 
==> (A (1 1 1))

(let ((a '(1 1 1)))
  `(a ,@a))
 
==> (A 1 1 1)

(defmacro memoize (f)
  (let ((body (cdr (getd f)))
        (parm (cadr (getd f))))
   `(let ((asso nil))
    (defun ,f ,parm
        (let ((tmp (assoc ,@parm asso)))
            (if tmp (cdr tmp)
                (let ((r ((lambda ,@body) ,@parm)))
                  (push (cons ,@parm r) asso) r)))))))

((N) (IF (<= N 2) 1 (+ (FIB (- N 1)) (FIB (- N 2)))))

`(let ((asso nil))
    (defun fib (N)
         (let ((tmp (assoc N asso)))
              (if tmp (cdr tmp)
                 (let ((r ((lambda (N) (if (<= N 2) 1 (+ (FIB (- N 1)) (FIB (- N 2))))) N)))
                        (push (cons N r) asso) r )))))

(let ((x 4))
   ((lambda (x) (* x x)) x))
 
==> 16

(defun g (n) 
   (if (< n 2) 1 (+ (g (- n 1)) (g (- n 2)) (g (- n 3)))))

(memoize g)
==> G
 
(g 10)
==> 355
 
(context 'g)
==> ((ASSO ((10 . 355) (9 . 193) (8 . 105) (7 . 57) (6 . 31) (5 . 17) (4 . 9) (3 . 5) (2 . 3) (-1 . 1) (0 . 1) (1 . 1))))

(defmacro memoize (f)
  (let ((body (cdr (getd f)))
        (parm (cadr (getd f))))
   `(let ((asso nil))
     (defun ,f ,parm
          (let ((tmp (assoc (list ,@parm) asso)))
              (if tmp (cdr tmp)
                  (let ((r ((lambda ,@body) ,@parm)))
                       (push (cons (list ,@parm) r) asso) r)))))))

(let ((tmp (assoc (x y) asso))) …

(defun g (x y)
  (cond ((or (<= x 0) (<= y 0)) 1)
              (t (+ (g (- x 1) y) (g x (- y 1)) (g (- x 2) (- y 2))))))

(g 6 7)
==> 5139

(memoize g)
==> G
 
(g 6 7)
==> 5139

(defmacro memoize (f)
  (let ((h    (gensym 'hash))
        (body (cdr (getd f)))
        (parm (cadr (getd f))))
   `(let ((!hash (quote ,h)))
        (hashCreate (quote ,h))
        (defun ,f ,parm
       (if (hashKeyExist (quote ,h) (output (list ,@parm))) 
            (car (hashGet (quote ,h) (output (list ,@parm))))
              (let ((r ((lambda ,@body) ,@parm)))
            (hashPut (quote ,h) (output (list ,@parm)) r) r))))))

(context 'g)
==> ((!HASH HASH5))

(hashMap 'hash5 (lambda (k v) (printline (list k v))) )
 
("(0 7)" 1)
("(0 6)" 1)
… … …
("(6 5)" 1241)
("(6 6)" 2643)
("(6 7)" 5139)

(defmacro memoize (f)
  (let ((h    (gensym 'hash))
        (body (cdr (getd f)))
        (parm (cadr (getd f))))
   `(let ((!memoize (quote ,f))
          (body (quote ,body))
          (!hash (quote ,h)))
        (hashCreate (quote ,h))
        (defun ,f ,parm
          (if (hashKeyExist (quote ,h) (output (list ,@parm))) 
              (car (hashGet (quote ,h) (output (list ,@parm))))
              (let ((r ((lambda ,@body) ,@parm)))
                    (hashPut (quote ,h) (output (list ,@parm)) r) r))))))

(defmacro unmemoize (f)
  (if (null (assoc '!memoize (context f))) (raiseerror "Функция не была мемоизирована!")
      (let* ((context (context f))
             (body    (cadr (assoc 'body context))))
                 (hashDestroy (cadr (assoc '!hash context)))  
               `(defun ,f ,@body))))

(defun f (x y z) (+ x (* y y) (* z z z))) ;; Определяем функцию
==> F
 
(f 1 2 3) ;; Проверяем работоспособность
==> 32 ;; Верно
 
(f 1 2) ;; Пробуем задать не все аргументы...
 
PairLis: Слишком мало фактических параметров 
 
Функция: F
Формальные  параметры: (X Y Z)
Фактические параметры: (1 2)
==> ERRSTATE

(defun s (&rest x) ;; неопределенное к-во параметров собирается в список x
  (apply '+ x)) ;; и этот список суммируется
==> S
 
(s 1 2) ;; два параметра
==> 3
 
(s 1 2 3) ;; три параметра
==> 6

(defun func-gen (x)
   (lambda (y) (+ x (* y y))))
==> FUNC-GEN
 
(func-gen 5)
==> (CLOSURE (Y) ((+ X (* Y Y))) ((X 5)))

(funcall (func-gen 5) 7)
==> 54

(lambda (хвост-plist) (apply f (cons x хвост-plist)))

(defun g (x y z) (+ x (* x y) (* x y z)))
 
==> G
(getd 'g)
 
==> (EXPR (X Y Z) (+ X (* X Y) (* X Y Z)))

(defun part-apply (f a)
  (let* ((plist (cadr (getd f))) ;; исходный список параметров
         (rlist (cdr plist))     ;; список параметров без первого 
         (clist (cons a rlist))) ;; список для вызова с заданным a
        `(lambda ,rlist (apply (quote ,f) (list ,@clist)))))

(part-apply 'g 111)
 
==> (LAMBDA (Y Z) (APPLY (QUOTE G) (LIST 111 Y Z)))

(g 111 1 2)
 
==> 444 ;; исходный результат
 
(funcall (part-apply 'g 111) 1 2) ;; вызов "по-коммон-лисповски"
 
==> 444 
 
((part-apply 'g 111) 1 2) ;; вызов "по-схемному"
 
==> 444

(defun part-apply (f a)
  (cond ((and (atom f) (member 'expr (proplist f))) ;; *** функция ***
         (let* ((plist (cadr (getd f))) ;; исходный список параметров
                (rlist (cdr plist))          ;; список параметров без первого 
                (clist (cons a rlist)))    ;; список для вызова с заданным a 
               `(lambda ,rlist (apply (quote ,f) (list ,@clist)))))
        ((eq 'lambda (car f))   ;; *** лямбда-выражение ***
         (let* ((plist (cadr f))        ;; исходный список параметров
                (rlist (cdr plist))       ;; список параметров без первого 
                (clist (cons x rlist))) ;; список для вызова с заданным x
               `(lambda ,rlist (apply (quote ,f) (list ,@clist)))))
        (t (raiseerror "part-apply: неверен функциональный аргумент"))))

(part-apply (part-apply 'g 1) 2) ;; двукратное применение возвращает функцию одного аргумента
 
==> (LAMBDA (Z) (APPLY (QUOTE (LAMBDA (Y Z) (APPLY (QUOTE G) (LIST 1 Y Z)))) (LIST 2 Z)))
 
((part-apply (part-apply 'g 1) 2) 3) ;; ее можно вызвать и получить верный результат
 
==> 9
 
(part-apply (part-apply (part-apply 'g 111) 1) 2) ;; трехкратное применение возвратит безаргументную функцию
 
==> (LAMBDA NIL (APPLY (QUOTE (LAMBDA (Z) (APPLY (QUOTE (LAMBDA (Y Z) (APPLY (QUOTE G) (LIST 111 Y Z)))) (LIST 1 Z)))) (LIST 2)))
 
((part-apply (part-apply (part-apply 'g 111) 1) 2)) ;; ее тоже можно вызвать...
 
==> 444
 
(setq u (part-apply 'g 111)) ;; результат частичного применения можно присвоить переменной
 
==> (LAMBDA (Y Z) (APPLY (QUOTE G) (LIST 111 Y Z)))
;; Создана глобальная переменная U
 
(part-apply u 1) ;; частичное применение можно продолжить
 
==> (LAMBDA (Z) (APPLY (QUOTE (LAMBDA (Y Z) (APPLY (QUOTE G) (LIST 111 Y Z)))) (LIST 1 Z)))
 
((part-apply u 1) 2) ;; а можно вызвать
 
==> 444

(defmacro pcurry (f)
   (let* ((parmlist (cadr (getd f))) ;; список параметров f
           (body      (cddr (getd f))) ;; тело функции f
       (lp          (length parmlist)) ;; длина списка параметров f
       (cf          (implode (cons '! (explode f))))) ;; новое имя для результата каррирования
`(defun ,cf (&rest x)
   (let ((lx (length x))) ;; длина актуального списка параметров
        (cond  ((= lx ,lp) ;; полное применение
                    (let ((e `(lambda ,parmlist ,@body)))
                          (apply e x)))
                  ((> lx ,lp) ;; параметров слишком много
                          (raiseerror "curry: Слишком много фактических параметров"))
                  (t (let ((tmp nil)) ;; здесь будет результат
                (iter (for a in x) ;; частично применяем заданные параметры
        (setq tmp (if (null tmp) (part-apply (quote ,f) a) (part-apply tmp a))))
                       tmp)))))))

(pcurry g) ;; "каррируем" g
 
==> !G ;; "каррированный" вариант
 
(!g 1 2 3) ;; при обычном вызове
 
==> 9 ;; ведет себя как g
 
(!g 1 2) ;; если аргументов недостаточно - вернет функцию для обработки остальных
 
==> (LAMBDA (Z) (APPLY (QUOTE (LAMBDA (Y Z) (APPLY (QUOTE G) (LIST 1 Y Z)))) (LIST 2 Z)))
 
;; Можно сразу и вычислить результат:
 
((!g 1 2) 3) ;; остался один аргумент
 
==> 9
 
((!g 1) 2 3) ;; осталось два аргумента
 
==> 9
 
(!g 1 2 3 4) ;; лишние аргументы вызовут ошибку
 
curry: Слишком много фактических параметров
==> ERRSTATE