Discussion:
how do I apply recursively labels function
Bigos
2020-02-03 01:36:13 UTC
the following does not work because atomize is not defined

(defun flatten (l)
(labels ((atomize (ls a)
(if (endp ls)
a
(atomize (cdr ls)
(apply (if (consp (car ls)) 'atomize 'cons)
(list (car ls) a))))))
(reverse (atomize l nil))))

Is it SBCL problem or am I pushing the boundaries too far?
2020-02-03 02:05:37 UTC
Post by Bigos
the following does not work because atomize is not defined
(defun flatten (l)
(labels ((atomize (ls a)
(if (endp ls)
a
(atomize (cdr ls)
(apply (if (consp (car ls)) 'atomize 'cons)
(list (car ls) a))))))
(reverse (atomize l nil))))
Bigos
2020-02-03 08:24:58 UTC
thanks it works !!!
Bigos
2020-02-03 08:48:54 UTC
Post by Bigos
thanks it works !!!

(defun flatten (l)
(labels ((atomize (ls a)
(if (endp ls)
a
(atomize (cdr ls)
(apply
(if (consp
(car ls))
#'atomize #'cons)
(cons (car ls)
(cons a nil)))))))
(reverse (atomize l nil))))
2020-02-03 15:41:50 UTC
Post by Bigos
(defun flatten (l)
(labels ((atomize (ls a)
(if (endp ls)
a
(atomize (cdr ls)
(apply
(if (consp
(car ls))
#'atomize #'cons)
(cons (car ls)
(cons a nil)))))))
(reverse (atomize l nil))))
Compare that with the definition of flatten from On Lisp (I think),
which is essentially the same algorithm (I think) but avoids an
[n]reverse.

(defun flatten (l)
(labels ((atomize (ls acc)
(cond ((null ls) acc)
((atom ls) (cons ls acc))
(t (atomize (car ls) (atomize (cdr ls) acc))))))
(atomize l nil)))

For style look at rpw3's flatten

;;;From: ***@rpw3.org (Rob Warnock)
;;;Message-ID: <***@speakeasy.net>
;;;Date: Wed, 05 Oct 2011 07:02:59 -0500

(defun flatten (tree &aux ret)
(flet ((f (x)
(format t "> ~a~%" x)
(and (atom x) (push x ret))))
(nsubst '#:never-matches :never-used tree :key #'f))
(nreverse ret))

The last version of flatten I wrote 5 years ago was an iterative version
which had to handle improper lists:

(defun sloppy-flatten (x)
;; based on <***@robolove.meer.net>
(let (stack result)
(flet ((rec (item)
(if (atom item)
(push item result)
(loop (destructuring-bind (elem . rest) item
(push elem stack)
(when (atom rest)
(unless (null rest)
(push rest stack))
(return))
(setq item (cdr item)))))))
(declare (inline rec))
(rec x)
(loop (cond ((endp stack) (return result))
(t (funcall #'rec (pop stack))))))))

I haven't kept track of the TR ones
2020-02-03 18:29:39 UTC
Post by Bigos
the following does not work because atomize is not defined
(defun flatten (l)
(labels ((atomize (ls a)
(if (endp ls)
a
(atomize (cdr ls)
(apply (if (consp (car ls)) 'atomize 'cons)
(list (car ls) a))))))
(reverse (atomize l nil))))
And the reason this works is that the function lookup of a symbol takes place
in the global namespace, whereas LABELS only creates the function locally.
Raymond Wiker
2020-02-05 16:18:37 UTC
Post by Bigos
the following does not work because atomize is not defined
(defun flatten (l)
(labels ((atomize (ls a)
(if (endp ls)
a
(atomize (cdr ls)
(apply (if (consp (car ls)) 'atomize 'cons)
(list (car ls) a))))))
(reverse (atomize l nil))))
There's no need for apply: just use

...
(atomize (cdr ls)
(if (consp (car ls))
(atomize (car ls) a)
(cons (car ls) a)))
...

Alternatively, using funcall instead of apply should be a little more
efficient.

Kaz Kylheku
2020-02-04 02:29:06 UTC
Post by Bigos
the following does not work because atomize is not defined
(defun flatten (l)
(labels ((atomize (ls a)
^^^^^^^ this is a lexical function binding.
Post by Bigos
(if (endp ls)
a
(atomize (cdr ls)
(apply (if (consp (car ls)) 'atomize 'cons)
^^^^^ ^^^^^^^^

This is a global binding lookup through a symbol.

Try #'atomize instead of 'atomize; in other words (function atomize)