John Thingstad wrote:

CL-USER> (pack '(a a a a b c c a a d e e e e))
(NIL (A A A A) (B) (C C) (A A) (D) (E E E E))

and cons of the list seemed to have unnecessary NIL.

I'm not sure if it is a bug on clisp.
Please give me some advice.

Sorry about my strange English. (I'm not a native speaker)

I have a devil of a time understanding your code.
After translating it I came up with:

(defun pack (list)
(labels ((build (source sub-list result)
(let ((current (first source))
(previous (first sub-list)))
(cond ((null source)
(nreverse (cons sub-list result)))
((eql current previous)
(build (rest source) (cons current sub-list) result))
(t
(build (rest source) (cons current nil)
(if (consp sub-list) (cons sub-list result) result))))))) ; this is different
(build list nil nil)))

The problem came from cons'ing ls1 to ls2 the first time the function is called when ls1 is nil.
The code here corrects the problem.
This way of solving the problem using tail recursion and accumulators is
very Scheem'ish.
Here is a more Lisp'ish solution.

(defun pack (list)
(let (result-list sub-list)
(do ((current list (rest current))
(previous nil current))
((null current)
(push sub-list result-list)
(nreverse result-list))
(when (and (not (eql (first current) (first previous))) (consp sub-list))
(push sub-list result-list)
(setf sub-list nil))
(push (first current) sub-list))))

Gauche Scheme:

(define (place x a b)
(let ((ok (or (null? a) (equal? x (car a)))))
(list (cons x (if ok a '()))
(if ok b (cons a b)))))

(define (clump the-list)
(apply cons
(fold-right
(cut apply place <> <>)
'(() ())
the-list)))

(clump '(a a a a b c c a a d e e e e))
===>
((a a a a) (b) (c c) (a a) (d) (e e e e))

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

On 2/17/2022, Robert L. wrote:

John Thingstad wrote:

CL-USER> (pack '(a a a a b c c a a d e e e e))
(NIL (A A A A) (B) (C C) (A A) (D) (E E E E))

and cons of the list seemed to have unnecessary NIL.

I'm not sure if it is a bug on clisp.
Please give me some advice.

Sorry about my strange English. (I'm not a native speaker)

I have a devil of a time understanding your code.
After translating it I came up with:

(defun pack (list)
(labels ((build (source sub-list result)
(let ((current (first source))
(previous (first sub-list)))
(cond ((null source)
(nreverse (cons sub-list result)))
((eql current previous)
(build (rest source) (cons current sub-list) result))
(t
(build (rest source) (cons current nil)
(if (consp sub-list) (cons sub-list result) result))))))) ; this is different
(build list nil nil)))

The problem came from cons'ing ls1 to ls2 the first time the function is called when ls1 is nil.
The code here corrects the problem.
This way of solving the problem using tail recursion and accumulators is very Scheem'ish.
Here is a more Lisp'ish solution.

(defun pack (list)
(let (result-list sub-list)
(do ((current list (rest current))
(previous nil current))
((null current)
(push sub-list result-list)
(nreverse result-list))
(when (and (not (eql (first current) (first previous))) (consp sub-list))
(push sub-list result-list)
(setf sub-list nil))
(push (first current) sub-list))))

Gauche Scheme:

(define (place x a b)
(let ((ok (or (null? a) (equal? x (car a)))))
(list (cons x (if ok a '()))
(if ok b (cons a b)))))

(define (clump the-list)
(apply cons
(fold-right
(cut apply place <> <>)
'(() ())
the-list)))

(clump '(a a a a b c c a a d e e e e))
===>
((a a a a) (b) (c c) (a a) (d) (e e e e))

Shorter:

(use srfi-1) ;; car+cdr

(define (place x acc)
(let-values (((a b) (car+cdr acc)))
(if (or (null? a) (equal? x (car a)))
(cons (cons x a) b)
(cons* (list x) a b))))

(define (clump the-list)
(fold-right
place
'(())
the-list))

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

On 2/17/2022, Robert L. wrote:

John Thingstad wrote:

CL-USER> (pack '(a a a a b c c a a d e e e e))
(NIL (A A A A) (B) (C C) (A A) (D) (E E E E))

and cons of the list seemed to have unnecessary NIL.

I'm not sure if it is a bug on clisp.
Please give me some advice.

Sorry about my strange English. (I'm not a native speaker)

I have a devil of a time understanding your code.
After translating it I came up with:

(defun pack (list)
(labels ((build (source sub-list result)
(let ((current (first source))
(previous (first sub-list)))
(cond ((null source)
(nreverse (cons sub-list result)))
((eql current previous)
(build (rest source) (cons current sub-list) result))
(t
(build (rest source) (cons current nil)
(if (consp sub-list) (cons sub-list result) result))))))) ; this is different
(build list nil nil)))

The problem came from cons'ing ls1 to ls2 the first time the function is called when ls1 is nil.
The code here corrects the problem.
This way of solving the problem using tail recursion and accumulators is very Scheem'ish.
Here is a more Lisp'ish solution.

(defun pack (list)
(let (result-list sub-list)
(do ((current list (rest current))
(previous nil current))
((null current)
(push sub-list result-list)
(nreverse result-list))
(when (and (not (eql (first current) (first previous))) (consp sub-list))
(push sub-list result-list)
(setf sub-list nil))
(push (first current) sub-list))))

Gauche Scheme:

(define (place x a b)
(let ((ok (or (null? a) (equal? x (car a)))))
(list (cons x (if ok a '()))
(if ok b (cons a b)))))

(define (clump the-list)
(apply cons
(fold-right
(cut apply place <> <>)
'(() ())
the-list)))

(clump '(a a a a b c c a a d e e e e))
===>
((a a a a) (b) (c c) (a a) (d) (e e e e))

(use srfi-1) ;; car+cdr for Gauche Scheme
or
(require srfi/1) ;; car+cdr for Racket

(define (clump them r)
(if (null? them)
r
(let ((x (car them)))
(let-values
(((a b)
(if (and (pair? r) (equal? x (caar r)))
(car+cdr r)
(values '() r))))
(clump (cdr them) (cons (cons x a) b))))))

(clump '(a a b c c) '())
===>
((c c) (b) (a a))

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)