
;;;; Different ways to write a recursive shallow copy of a list.
;;;;  Recall that Elisp does not perform TCO, so there is really
;;;;    no tangible performance benefit from the tail-calls---
;;;;    but SBCL should show one!

;;;; Project idea: write a bytecode-level profiler for Elisp,
;;;;   capable of precisely counting the cons cells created by a function.

;;; Basic recursive (not tail-recursive) shallow copy of a list
(defun copy-list (x)
  (cond ((null x) nil)
        ((consp x)
         (cons (car x) (copy-list (cdr x))))))  ; not tail-recursive, due to cons needing
                                                ;  to be called after copy-list call.

;;; Tail-recursive, with accumulator and append.
;;;   Note: append makes it ver suboptimal.
(defun copy-list (x acc)
  (cond ((null x) acc)    ; nothing left to do, return accumulated result
        ((consp x)
         (copy-list (cdr x) (append acc 
                                    (cons (car x) nil)))))) ; why this cons? see below

;; To see the trace: (trace-function 'copy-list)

;;-------------------[ Regarding append ]-------------------
;; Recall, to get a list, you need to pass a list to append as a second 
;;   argument. Otherwise, you get a list ending in a dotted pair:
(append '(1 23 ) 'a)
(1 23 . a)

;; Also, recall this:
(append nil 'a)
a
(nconc nil 'a)
a
(nconc nil '(a))
(a)
;;-----------------------------------------------------------

;; The above is very wasteful: append must traverse the list 
;;   every time _and_ makes shallow copies of its arguments!
;;
;; This version is a bit better: it does not create extra
;;  cons cells, just the one needed per element for the shallow copy.
;;  However, nconc still traverses the list every time.
(defun copy-list (x acc)
  (cond ((null x) acc)
        ((consp x)
         (copy-list (cdr x) (nconc acc
                                   (cons (car x) nil))))))

;; This should be more more efficient: only one cons cell created per element,
;;   _prepended_ to the accumulator list (to save traversing to its end),
;;   and then only one travesal at the end, to reverse the accumulator list.
(defun copy-list (x acc)
  (cond ((null x) (nreverse acc))
        ((consp x)
         (copy-list (cdr x) (cons (car x) acc)))))

;;; What if we don't want the NREVERSE? The problem is that if we
;;;   want to append, not _prepend_ the new cons cells, we need 
;;;   to modify the cons cell created during the _previous_ recursive
;;;   call, pushing its modification into the current call. 
;;; This technique can be generalized to any simple data construction operations
;;;   that need to occur with the _results_ of the recursive call (which
;;;   would break straightforward tail recursion); see
;;;   https://en.wikipedia.org/wiki/Tail_call#Tail_recursion_modulo_cons

;;; Here it is for shallow list copy:
(defun copy-list (l)
  (let ((seed-cell (cons 'dummy nil)))
    (labels ((tc (x cell)
                 ;; this is the cell to attach our new one to
                 (cond ((null x) nil)  ; doesn't matter. This should be an IF
                       ((consp x)
                        (let ((new-cell (cons (car x) nil)))
                          (rplacd cell new-cell)     ; destructive on cell from previous call!
                          (tc (cdr x) new-cell))))))
      (tc l seed-cell)    ; tc's return value isn't relevant; we're after its side-effect on seed-cell
      (cdr seed-cell))))

;;;; In reality, there's barely a difference between the three.
;;;;  Likely, this is a result of garbage collection:

;; append version:
"copy-list      600000      9.4691200000  1.578...e-05"
"copy-list      600000      10.140059000  1.690...e-05"
"copy-list      600000      3.1072689999  5.178...e-06" ; <--??? why? Garbage collection skipped?
"copy-list      600000      13.173576000  2.195...e-05"
"copy-list      600000      11.184488000  1.864...e-05"

;; nconc version:
"copy-list      600000      9.9489790000  1.658...e-05"
"copy-list      600000      9.3005690000  1.550...e-05"
"copy-list      600000      9.7946060000  1.632...e-05"

;; nreverse+cons version:
"copy-list      600000      9.6623510000  1.610...e-05"
"copy-list      600000      10.688309000  1.781...e-05"
"copy-list      600000      10.430074000  1.738...e-05"
"copy-list      600000      9.9335370000  1.655...e-05"
"copy-list      600000      9.2891800000  1.548...e-05"
"copy-list      600000      10.448907000  1.741...e-05"

;; modulo-cons version:
"copy-list      100000      1.5461220000  1.546...e-05"
"copy-list      100000      1.1891990000  1.189...e-05"
"copy-list      100000      0.5176339999  5.176...e-06"  ; <-- ?? 
"copy-list      100000      1.5362150000  1.536...e-05"
"copy-list      100000      1.4385760000  1.438...e-05"
"copy-list      100000      1.5139790000  1.513...e-05"

;;;
;;;  Profiling script for the above. elp-results pops up its result buffer,
;;;    but I wanted just the plain string of results. Hence save-window-excursion
;;;    saves and restores the window configuration, then I grab the contents
;;;    of the results buffer, and strip the ending newline   
;;; 
(defun profile-here ()
  ;; instrument or re-instrument function with ELP library
  (elp-instrument-function 'copy-list)
  (dotimes (i 100000)
    (copy-list '(a b c d e))) ; nil))
  ;; grab results from the specially named buffer
  ;; (setq elp-use-standard-output t) -- this doesn't really work, extra buffer still gets shown!
  (save-window-excursion
    (elp-results))
  (with-current-buffer (get-buffer "*ELP Profiling Results*")
    ;; is this replace really needed? Just grab from (point-min) to (1- (point-max))?
    (replace-regexp-in-string "\n\\'" ; replace \n anchored at the end of string \' 
                              ""      ;  ...with empty string
                              (buffer-substring-no-properties (point-min) (point-max)))))

;; To run a profiling round:
(profile-here)

;; Something about how the ELP profiler works:
;;   https://www.emacswiki.org/emacs/EmacsLispProfiler
(pp (symbol-function 'copy-list))
;; #[128 "\300\301\302#\207"
;;       [apply
;;        #[385 "	\203\f \300	=\203\f \304\300N\305\204 \306\307\300\"\210\n\204& \310\"\262\202V \305\211\211\311\311HTI\266\312 \262\310\"\262\312 \262\211\313\313H\314\315\"!\266\202\\I\266	\203b \300	=\203b \305\207"
;;              [copy-list elp-master elp-record-p elp-timer-info-property t nil error "%s is not instrumented for profiling" apply 0 current-time 1 float-time time-subtract]
;;              16 "This function has been instrumented for profiling by the ELP.\nELP is the Emacs Lisp Profiler.  To restore the function to its\noriginal definition, use \\[elp-restore-function] or \\[elp-restore-all].\n\n(fn FUNC &rest ARGS)"]
;;        (lambda
;;          (x acc)
;;          (cond
;;           ((null x)
;;            acc)
;;           ((consp x)
;;            (copy-list
;;             (cdr x)
;;             (append acc
;;                     (cons
;;                      (car x)
;;                      nil))))))
;;        ((name . ELP-instrumentation\ )
;;         (depth . -99))]
;;       5 nil]
;; "#[128 \"\\300\\301\\302#\\207\"
;;       [apply
;;        #[385 \"	\\203\\f \\300	=\\203\\f \\304\\300N\\305\\204 \\306\\307\\300\\\"\\210\\n\\204& \\310\\\"\\262\\202V \\305\\211\\211\\311\\311HTI\\266\\312 \\262\\310\\\"\\262\\312 \\262\\211\\313\\313H\\314\\315\\\"!\\266\\202\\\\I\\266	\\203b \\300	=\\203b \\305\\207\"
;;              [copy-list elp-master elp-record-p elp-timer-info-property t nil error \"%s is not instrumented for profiling\" apply 0 current-time 1 float-time time-subtract]
;;              16 \"This function has been instrumented for profiling by the ELP.\\nELP is the Emacs Lisp Profiler.  To restore the function to its\\noriginal definition, use \\\\[elp-restore-function] or \\\\[elp-restore-all].\\n\\n(fn FUNC &rest ARGS)\"]
;;        (lambda
;;          (x acc)
;;          (cond
;;           ((null x)
;;            acc)
;;           ((consp x)
;;            (copy-list
;;             (cdr x)
;;             (append acc
;;                     (cons
;;                      (car x)
;;                      nil))))))
;;        ((name . ELP-instrumentation\\ )
;;         (depth . -99))]
;;       5 nil]
;; "


(setq l '(a b (c) d))
(a b (c) d)

(copy-list-tc '(a b (c) d))
(a b (c) d)

(eq (caddr l) (caddr (copy-list-tc l)))
t