File: utilities.lisp

package info (click to toggle)
cl-metabang-bind 20200101.git9ab6e64-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm
  • size: 240 kB
  • sloc: lisp: 1,608; makefile: 2
file content (19 lines) | stat: -rw-r--r-- 506 bytes parent folder | download | duplicates (6) 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
(in-package #:metabang-bind-test)

(defun collect-tree (tree &key transform)
  "Maps FN over every atom in TREE."
  (bind ((transform (or transform #'identity))
	 ((:labels doit (x))
	  (cond
	    ;; ((null x) nil)
	    ((atom x) (funcall transform x))
	    (t
	     (cons
	      (doit (car x))
	      (when (cdr x) (doit (cdr x))))))))
    (doit tree)))

(defun remove-gensyms (tree)
  (collect-tree tree :transform (lambda (x) (when (or (not (symbolp x))
						      (symbol-package x))
					      x))))