I'm also a relative newbie to CL, but that seemed like an interesting task, so I went for it. Experienced sheets, comment on this code! @ user1176517 if you find any errors let me know!
First, a couple of comments: I wanted to do this O (n), not O (n ^ 2), so I made recursive functions return both the head and tail (i.e. the last minuses) of the lists as a result of the recursive processing of the tree branch. So in conc-lists-start I can nconc last cons of one list to the first cons of another, without nconc to go down the list. For this, I used several return values, which, unfortunately, inflate the code with an honest bit. To make sure tail is the last minus of the resulting list, I need to check if cdr has a value before repeating.
There are two recursive functions that process a tree: conc-lists and conc-lists-first . When conc-lists sees a (start) , recursive processing continues with conc-lists-start . Similarly, when conc-lists-start sees (end) , recursive processing continues with conc-lists .
I am sure that he could use more comments ... I can add more later.
Here's the working code:
;;; conc-lists ;;; runs recursively over a tree, looking for lists which begin with 'start ;;; such lists will be nconc'd with following lists a same level of nesting, ;;; up until the first list which begins with 'end ;;; lists which are nconc'd onto the (start) list are first recursively processed ;;; to look for more (start)s ;;; returns 2 values: head *and* tail of resulting list ;;; DESTRUCTIVELY MODIFIES ARGUMENT! (defun conc-lists (lst) (cond ((or (null lst) (atom lst)) (values lst lst)) ((null (cdr lst)) (let ((head (conc-process-rest lst))) (values head head))) (t (conc-process-rest lst)))) ;;; helper to factor out repeated code (defun conc-process-rest (lst) (if (is-start (car lst)) (conc-lists-start (cdar lst) (cdr lst)) (multiple-value-bind (head tail) (conc-lists (cdr lst)) (values (cons (conc-lists (car lst)) head) tail)))) ;;; conc-lists-start ;;; we have already seen a (start), and are nconc'ing lists together ;;; takes *2* arguments so that 'start can easily be stripped from the ;;; arguments to the initial call to conc-lists-start ;;; recursive calls don't need to strip anything off, so the car and cdr ;;; are just passed directly (defun conc-lists-start (first rest) (multiple-value-bind (head tail) (conc-lists first) (cond ((null rest) (let ((c (list head))) (values cc))) ((is-end (car rest)) (multiple-value-bind (head2 tail2) (conc-lists (cdr rest)) (values (cons head head2) tail2))) (t (multiple-value-bind (head2 tail2) (conc-lists-start (car rest) (cdr rest)) (nconc tail (car head2)) (values (cons head (cdr head2)) tail2)))))) (defun is-start (first) (and (listp first) (eq 'start (car first)))) (defun is-end (first) (and (listp first) (eq 'end (car first))))
source share