How to copy a counter made using closing Lisp?

Question

A classic example of closing Lisp is the following function that returns a counter:

(defun make-up-counter ()
  (let ((n 0))
    #'(lambda () (incf n))))

When called, it increments its counter and returns the result:

CL-USER > (setq up1 (make-up-counter))
#<Closure 1 subfunction of MAKE-UP-COUNTER 20099D9A>

CL-USER > (funcall up1)
1

CL-USER > (funcall up1)
2

When I showed this to a friend unfamiliar with Lisp, he asked how he could copy a counter to create a new independent counter of the same type. This does not work:

CL-USER > (setq up2 up1)
#<Closure 1 subfunction of MAKE-UP-COUNTER 20099D9A>

because up2 is not a new counter, it is just a different name for the same counter:

CL-USER > (funcall up2)
3

Here is my best attempt:

(defun make-up-counter ()
  (let ((n 0))
    #'(lambda (&optional copy)
        (if (null copy)
            (incf n)
          (let ((n 0))
            #'(lambda () (incf n)))))))

To return a copy of the counter, you call it with the argument t:

(defun copy-counter (counter) (funcall counter t))

It works for a first generation copy:

CL-USER > (setq up2 (copy-counter up1))
#<Closure 1 subfunction of MAKE-UP-COUNTER 200DB722>

CL-USER > (funcall up2)
1

, , , 2. , , make-up-counter .

?

Answer 1

, , labels:

(defun make-up-counter ()
  (labels ((new ()
             (let ((n 0))
               (lambda (&optional copy)
                 (if copy
                     (new)
                     (incf n))))))
    (new)))

, copy :

(defun make-up-counter ()
  (labels ((new (n)
             (lambda (&optional copy)
               (if copy
                   (new n)
                   (incf n)))))
    (new 0)))

, copy , , , else increment:

(defun make-up-counter ()
  (labels ((new (n)
             (lambda (&optional copy)
               (cond ((numberp copy) (new copy))
                     (copy (new n))
                     (t (incf n))))))
    (new 0)))

Answer 2

. , ...

(defun make-up-counter ()
  (let ((n 0))
    #'(lambda () (incf n))))

, . . FP ( , , ., , ), - . - - . - /, . , , .

:

CL-USER 36 > (make-up-counter)
#<anonymous interpreted function 40600015BC>

? , . , , , , , , ,... - - , , CLOS.

(defclass counter ()
  ((value :initarg :start :initform 0 :type integer)))

(defmethod next-value ((c counter))
   (with-slots (value) c
     (prog1 value
       (incf value))))

(defmethod copy-counter ((c counter))
  ...)

(defmethod reset-counter ((c counter))
  ...)

...

:

CL-USER 44 > (let ((c (make-instance 'counter :start 10)))
               (list (next-value c)
                     (next-value c)
                     (next-value c)
                     c))
(10 11 12 #<COUNTER 40200E6F3B>)

CL-USER 45 > (describe (fourth *))

#<COUNTER 40200E6F3B> is a COUNTER
VALUE      13

Answer 3

Rainer , . defclass , :

(defstruct counter (value 0))

, : (make-counter), (make-counter :value x) (copy-counter c) . .

(let* ((c (make-counter))
       (d (copy-counter c)))
  (incf (counter-value c))
  (values c d))

#S(counter :value 1)
#S(counter :value 0)

, reset , , .

Answer 4

, copy-counter , , :

(defun new-counter(&optional (n 0))
  (lambda (&optional noincrement)
    (if noincrement n (incf n))))

(defun copy-counter(c)
  (new-counter (funcall c t)))

:

CL-USER> (let* ((up1 (new-counter))
                (up2 (progn (funcall up1) (funcall up1) (copy-counter up1))))
           (print (funcall up2))
           (print (funcall up2))
           (print (funcall up2))
           (print (funcall up1))
           "end test")

3 
4 
5 
3 
"end test"

Answer 5

- make-up-counter , .

(defun make-up-counter (&optional (initial-count 0))
  (let ((count initial-count))
    #'(lambda () (incf count))))

, , , , .

(defun copy-counter (counter)
  (make-up-counter (funcall counter)))

, "", ,

(defun make-up-counter (&optional (initial-count 0))
  (let ((count initial-count))
    #'(lambda (&optional (operation :increment))
        (ecase operation
          (:inspect count)
          (:increment (incf count))))))

(defun copy-counter (counter)
  (make-up-counter (funcall counter :inspect)))

,

(let ((1st-counter (make-up-counter)))
  (loop :repeat 3 :do (funcall 1st-counter))
  (let ((2nd-counter (copy-counter 1st-counter)))
    (loop :repeat 3 :do (funcall 1st-counter))
    (format t "1st counter: ~A~%2nd counter: ~A~%"
            (funcall 1st-counter :inspect)
            (funcall 2nd-counter :inspect))))

1- : 6

2- : 3

Answer 6

, API , :

(make-counter <integer>) --> yields new counter starting at <integer>
(make-counter <counter>) --> yields a clone of counter

, ( ). nil, . . : - , . API make-counter , "copy".

(defun make-counter (&optional (constructor-arg 0))
  (etypecase constructor-arg
    (integer 
      (lambda (&optional opcode) ;; opcode selects method
        (ecase opcode ;; method dispatch
          ((nil) (prog1 constructor-arg (incf constructor-arg)))
          (copy-self (make-counter constructor-arg)))))
    (function
      (funcall constructor-arg 'copy-self))))

:

[1]> (defvar x (make-counter 3))
X
[2]> (funcall x)
3
[3]> (funcall x)
4
[4]> (defvar y (make-counter x))
Y
[5]> (funcall x)
5
[6]> (funcall x)
6
[7]> (funcall x)
7
[8]> (funcall y)
5
[9]> (funcall y)
6
[10]> (funcall x)
8
[11]> (funcall y)
7

, make-counter , API:

(defun make-counter (&optional (constructor-arg 0))
  (lambda (&optional opcode)
    (ecase opcode
      ((nil) (prog1 constructor-arg (incf constructor-arg)))
      (copy-self (make-counter constructor-arg)))))

(defun copy-counter (counter)
  (funcall constructor-arg 'copy-self))

copy-counter - nothing more than a shell for the dispatcher API based on code at the lower level.