File: lw-compat.lisp

package info (click to toggle)
cl-lw-compat 0.23-1
  • links: PTS
  • area: main
  • in suites: jessie, jessie-kfreebsd, squeeze, stretch, wheezy
  • size: 56 kB
  • ctags: 8
  • sloc: lisp: 48; makefile: 29
file content (50 lines) | stat: -rw-r--r-- 1,840 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
(in-package #:lispworks)

#+lispworks
(eval-when (:compile-toplevel :load-toplevel :execute)
  (error "lw-compat is not needed in LispWorks."))

(define-modify-macro appendf (&rest lists)
  append "Appends lists to the end of given list.")

(define-modify-macro nconcf (&rest lists)
  nconc "Appends lists to the end of given list by NCONC.")

(defmacro rebinding (vars &body body)
  "Ensures unique names for all the variables in a groups of forms."
  (loop for var in vars
	for name = (gensym (symbol-name var))
	collect `(,name ,var) into renames
	collect ``(,,var ,,name) into temps
	finally (return `(let ,renames
			   (with-unique-names
                               ,vars
                             `(let (,,@temps)
                                ,,@body))))))

(define-modify-macro removef (item &rest keys)
  (lambda (place item &rest keys &key test test-not start end key)
    (declare (ignorable test test-not start end key))
    (apply #'remove item place keys))
  "Removes an item from a sequence.")

(defmacro when-let ((var form) &body body)
  "Executes a body of code if a form evaluates to non-nil,
   propagating the result of the form through the body of code."
  `(let ((,var ,form))
     (when ,var
       (locally
         ,@body))))

(defmacro when-let* (bindings &body body)
  "Executes a body of code if a series of forms evaluates to non-nil,
   propagating the results of the forms through the body of code."
  (loop for form = `(progn ,@body) then `(when-let (,(car binding) ,(cadr binding)) ,form)
        for binding in (reverse bindings)
        finally (return form)))

(defmacro with-unique-names (names &body body)
  "Returns a body of code with each specified name bound to a similar name."
  `(let ,(mapcar (lambda (name) `(,name (gensym ,(symbol-name name))))
                 names)
     ,@body))