blob: b39f8c41f94c286465dae6dde8bbc4f0d2a6d17a (
plain)
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
|
(in-package :agnostic-lizard)
(defmacro eval-with-current-environment ((var) &body code &environment env)
"Evaluate code in a lexical environment where var is bound to the lexical
environment object corresponding to the macro call position"
`',(funcall (eval `(lambda (,var) ,@code)) env))
(defun separate-declarations (entries &key (enable-docstring t))
"Separate a list of entries into declarations and forms, with a possible docstring, if enabled"
(loop
with docstring := (not enable-docstring)
with declarations := nil
with forms := nil
for header := t then header-continued
for entry in entries
for operator := (and (consp entry) (car entry))
for header-continued :=
(and
header
(or
(and (stringp entry) (not docstring) (setf docstring entry) t)
(eq operator 'declare)))
do (if header-continued (push entry declarations) (push entry forms))
finally
(return
; (lambda () "asd") is the same as (constantly "asd")
(if (and (null forms) (stringp docstring)
(eq docstring (car declarations)))
(list (reverse (cdr declarations)) (list docstring))
(list (reverse declarations) (reverse forms))))))
(defun go-tag-p (x) (or (integerp x) (symbolp x)))
(defun lambda-list-variable-names (l)
(loop
for name in l
unless (find name lambda-list-keywords)
collect (if (consp name) (car name) name)))
|
