Subject: limits of UNION? (program stack depth)

From: [email-masked] (Jorg-Cyril Hohle)
Date: Wed, 23 Dec 1998 16:02:25 +0100

Hello,

I was trying to transform a sequence of

 (apply #'n-ary-union
	(mapcar #'(lambda (elt) (return-a-list elt))
	        stuff))
into

 (reduce #'union stuff :key #'(lambda (elt (return-a-list elt))))

which I thought would be more efficient, but I hit a limit in CLISP.

I get a stack reset from TEST2, while TEST1 succeeds.  The culprit is
UNION (or the special shape of the list ...).  N-ARY-UNION in TEST1
uses REMOVE-DUPLICATES and APPLY + APPEND instead of UNION.

> (length (union (first *foo*) (second *foo*)))

*** - Programmstack-Überlauf: RESET
> (lisp-implementation-version)

"1998-07-30 (Juli 1998)"
> (length (union '(3 4) (second *foo*)))

10001
> (length (union (second *foo*) '(3 4)))

*** - Programmstack-Überlauf: RESET

10000 looks like a pretty low limit to me.  The experimental limit
seems to be below 1500 in my configuration.

The overflow seems to indicate that in DEFS1.LSP:UNION the (APPLY
#'UNION ...) call is not recognized as tail recursive so calls pile
up, despite the
36    (APPLY&SKIP&RET 2 7)
byte code instruction I see in the disassembly.

Regards,
	Jo"rg Ho"hle.
[email-masked]		http://zeus.gmd.de/~hoehle/amiga.html

(defun n-ary-union (&rest sets)
  (remove-duplicates (apply #'append sets)))

(defun test1 (lists)
  (apply #'n-ary-union (mapcar #'(lambda (elt) (mapcar #'1+ elt)) lists)))
(defun test2 (lists)
  (reduce #'union lists :key  #'(lambda (elt) (mapcar #'1+ elt))))

(defvar *foo*)
(progn (setq *foo* (loop repeat 2 collect (make-list 10000 :initial-element 3))) nil)

#+clisp (space (test1 *foo*))
#+clisp (space (test2 *foo*))

---

From: Bruno Haible <[email-masked]>
Date: Thu, 31 Dec 1998 18:36:45 +0100 (MET)

> seems to be below 1500 in my configuration.

This is the maximum stack depth, highly platform dependent.

> #'UNION ...) call is not recognized as tail recursive

There are two calls (APPLY #'UNION ...) in the function UNION. One of
them is not tail-recursive. The right fix is to make UNION work iteratively,
so it can work on lists of arbitrary length. Please apply the patch below.

Bruno

*** src/defs1.lsp.bak	Fri Dec  4 10:04:01 1998
--- src/defs1.lsp	Thu Dec 31 18:02:39 1998
***************
*** 187,240 ****
  
  (defun union (list1 list2 &rest rest &key test test-not key)
    (declare (ignore test test-not key))
    (cond ((endp list1) list2)
          ((apply #'sys::member1 (car list1) list2 rest)
           (apply #'union (cdr list1) list2 rest))
          (t (cons (car list1) (apply #'union (cdr list1) list2 rest)))
! ) )
  
  (defun nunion (list1 list2 &rest rest &key test test-not key)
    (declare (ignore test test-not key))
    (cond ((endp list1) list2)
          ((apply #'sys::member1 (car list1) list2 rest)
           (apply #'nunion (cdr list1) list2 rest))
          (t (rplacd list1 (apply #'nunion (cdr list1) list2 rest)))
! ) )
  
  (defun intersection (list1 list2 &rest rest &key test test-not key)
    (declare (ignore test test-not key))
    (cond ((endp list1) nil)
          ((apply #'sys::member1 (car list1) list2 rest)
           (cons (car list1)
                 (apply #'intersection (cdr list1) list2 rest)))
          (t (apply #'intersection (cdr list1) list2 rest))
! ) )
  
  (defun nintersection (list1 list2 &rest rest &key test test-not key)
    (declare (ignore test test-not key))
    (cond ((endp list1) nil)
          ((apply #'sys::member1 (car list1) list2 rest)
           (rplacd list1 (apply #'nintersection (cdr list1) list2 rest)) )
          (t (apply #'nintersection (cdr list1) list2 rest))
! ) )
  
  (defun set-difference (list1 list2 &rest rest &key test test-not key)
    (declare (ignore test test-not key))
    (cond ((endp list1) nil)
          ((not (apply #'sys::member1 (car list1) list2 rest))
           (cons (car list1)
                 (apply #'set-difference (cdr list1) list2 rest)
          ))
          (t (apply #'set-difference (cdr list1) list2 rest))
! ) )
  
  (defun nset-difference (list1 list2 &rest rest &key test test-not key)
    (declare (ignore test test-not key))
    (cond ((endp list1) nil)
          ((not (apply #'sys::member1 (car list1) list2 rest))
           (rplacd list1 (apply #'nset-difference (cdr list1) list2 rest)) )
          (t (apply #'nset-difference (cdr list1) list2 rest))
! ) )
  
  (defun set-exclusive-or (list1 list2 &rest rest &key test test-not key)
    (declare (ignore test test-not key))
--- 187,306 ----
  
  (defun union (list1 list2 &rest rest &key test test-not key)
    (declare (ignore test test-not key))
+   #| ; recursive (not suitable for long lists):
    (cond ((endp list1) list2)
          ((apply #'sys::member1 (car list1) list2 rest)
           (apply #'union (cdr list1) list2 rest))
          (t (cons (car list1) (apply #'union (cdr list1) list2 rest)))
!   )
!   |# ; iterative
!   (let ((list1-filtered '()))
!     (dolist (item list1)
!       (unless (apply #'sys::member1 item list2 rest)
!         (setq list1-filtered (cons item list1-filtered))
!     ) )
!     (nreconc list1-filtered list2)
!   )
! )
  
  (defun nunion (list1 list2 &rest rest &key test test-not key)
    (declare (ignore test test-not key))
+   #| ; recursive (not suitable for long lists):
    (cond ((endp list1) list2)
          ((apply #'sys::member1 (car list1) list2 rest)
           (apply #'nunion (cdr list1) list2 rest))
          (t (rplacd list1 (apply #'nunion (cdr list1) list2 rest)))
!   )
!   |# ; iterative
!   (let ((first nil) (last nil))
!     (do ((l list1 (cdr l)))
!         ((endp l))
!       (unless (apply #'sys::member1 (car l) list2 rest)
!         (if last (rplacd last l) (setq first l))
!         (setq last l)
!     ) )
!     (if last (progn (rplacd last list2) first) list2)
!   )
! )
  
  (defun intersection (list1 list2 &rest rest &key test test-not key)
    (declare (ignore test test-not key))
+   #| ; recursive (not suitable for long lists):
    (cond ((endp list1) nil)
          ((apply #'sys::member1 (car list1) list2 rest)
           (cons (car list1)
                 (apply #'intersection (cdr list1) list2 rest)))
          (t (apply #'intersection (cdr list1) list2 rest))
!   )
!   |# ; iterative
!   (let ((list1-filtered '()))
!     (dolist (item list1)
!       (when (apply #'sys::member1 item list2 rest)
!         (setq list1-filtered (cons item list1-filtered))
!     ) )
!     (list-nreverse list1-filtered)
!   )
! )
  
  (defun nintersection (list1 list2 &rest rest &key test test-not key)
    (declare (ignore test test-not key))
+   #| ; recursive (not suitable for long lists):
    (cond ((endp list1) nil)
          ((apply #'sys::member1 (car list1) list2 rest)
           (rplacd list1 (apply #'nintersection (cdr list1) list2 rest)) )
          (t (apply #'nintersection (cdr list1) list2 rest))
!   )
!   |# ; iterative
!   (let ((first nil) (last nil))
!     (do ((l list1 (cdr l)))
!         ((endp l))
!       (when (apply #'sys::member1 (car l) list2 rest)
!         (if last (rplacd last l) (setq first l))
!         (setq last l)
!     ) )
!     (if last (progn (rplacd last nil) first) nil)
!   )
! )
  
  (defun set-difference (list1 list2 &rest rest &key test test-not key)
    (declare (ignore test test-not key))
+   #| ; recursive (not suitable for long lists):
    (cond ((endp list1) nil)
          ((not (apply #'sys::member1 (car list1) list2 rest))
           (cons (car list1)
                 (apply #'set-difference (cdr list1) list2 rest)
          ))
          (t (apply #'set-difference (cdr list1) list2 rest))
!   )
!   |# ; iterative
!   (let ((list1-filtered '()))
!     (dolist (item list1)
!       (unless (apply #'sys::member1 item list2 rest)
!         (setq list1-filtered (cons item list1-filtered))
!     ) )
!     (list-nreverse list1-filtered)
!   )
! )
  
  (defun nset-difference (list1 list2 &rest rest &key test test-not key)
    (declare (ignore test test-not key))
+   #| ; recursive (not suitable for long lists):
    (cond ((endp list1) nil)
          ((not (apply #'sys::member1 (car list1) list2 rest))
           (rplacd list1 (apply #'nset-difference (cdr list1) list2 rest)) )
          (t (apply #'nset-difference (cdr list1) list2 rest))
!   )
!   |# ; iterative
!   (let ((first nil) (last nil))
!     (do ((l list1 (cdr l)))
!         ((endp l))
!       (unless (apply #'sys::member1 (car l) list2 rest)
!         (if last (rplacd last l) (setq first l))
!         (setq last l)
!     ) )
!     (if last (progn (rplacd last nil) first) nil)
!   )
! )
  
  (defun set-exclusive-or (list1 list2 &rest rest &key test test-not key)
    (declare (ignore test test-not key))