Here’s a way (following the code structure by @coredump from their answer; runs about 4x faster on tio.run):
(defun permutations (list callback)
(if (null list)
(funcall callback #())
(let* ((all (cons 'head (copy-list list))) ; head sentinel FTW!
(perm (make-array (length list))))
(labels
((g (p i &aux (q (cdr p))) ; pick all items in arbitrary order:
(cond
((cdr q) ; two or more items left:
(loop while q do ; for each item in q:
(setf (svref perm i) (car q)) ; grab the item
(rplacd p (cdr q)) ; pluck it out
(g all (1+ i)) ; get the rest!
(rplacd p q) ; then, put it back
(pop p) ; and advance
(pop q))) ; the pointers
(T ; one last item left in q:
(setf (svref perm i) (car q)) ; grab the last item
(funcall callback perm))))) ; and call the callback
(g all 0)))))
Testing:
; [20]> (permutations '(1 2 3) #'(lambda (x) (princ x) (princ #\ )))
; #(1 2 3) #(1 3 2) #(2 1 3) #(2 3 1) #(3 1 2) #(3 2 1)
; [58]> (let ((acc (list))) (permutations '(1 2 3) #'(lambda (x)
; (push (coerce x 'list) acc))) (reverse acc))
; ((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))
; [59]> (let ((acc (list))) (permutations '() #'(lambda (x)
; (push (coerce x 'list) acc))) (reverse acc))
; (NIL)
This uses recursion to build the n nested loops computational structure for the n-long input list, at run time, with the fixed i = 0, 1, …, n-1 in each nested loop being the position in the result-holding permutation array to put the picked item into. And when all the n positions in the array are filled, once we’re inside the innermost loop (which isn’t even a loop anymore as it has just one element left to process), the user-supplied callback is called with that permutation array as its argument. The array is reused for each new permutation.
Implements the “shrinking domains” paradigm as in this high-level pseudocode with list splicing and pattern matching:
perms [] = [[]]
perms xs = [[x, ...p]
FOR [as, [x, ...bs]] IN (splits xs) -- pluck x out
FOR p IN perms [...as, ...bs]] -- and recurse
(where splits of a list produces all possible pairs of its sublists which, appended together, reconstitute the list; in particular, splits [] = [ [[],[]] ] and splits [1] = [ [[],[1]] , [[1],[]] ]); or, in a simple imperative pseudocode,
for item1 in list:
domain2 = remove item1 from list by position
for item2 in domain2:
domain3 = remove item2 from domain2 by position
for item3 in domain3:
......
......
for item_n in domain_n:
(callback
(make-array n :initial-contents
(list item1 item2 ... item_n)))
but in the real code we do away with all the quadratic interim storage used by this pseudocode, completely, by surgically manipulating the list structure. About the only advantage of the linked lists is their O(1) node removal capability; we might as well use it!
update: special-casing the last two elements of a permutation as well (by unrolling the last loop into the corresponding two calls to the callback) gives about ~ 1.5x additional speedup.
(In case the TIO link ever rots, here’s the pastebin with the working code.)
update: this technique is known as recursive-backtracking, creating the n nested loops backtracking computational structure by recursion.