blob: d1dd0e96beff25fe5685c7ef5beadcc53c86937c (
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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
(in-package :lambda-riffs)
(eval-when (:compile-toplevel :load-toplevel :execute)
;;; some functions for working with substitution variables
(defun substitute-var-p (symbol prefix)
(and (not (eql '$ symbol))
(symbolp symbol)
(<= (length prefix)
(length (symbol-name symbol)))
(string-equal (symbol-name symbol) prefix
:end1 (length prefix))))
(defun numeric-var-p (symbol prefix)
(and (substitute-var-p symbol prefix)
(digit-char-p
(elt (symbol-name symbol) (length prefix)))))
(set-dispatch-macro-character
#\# #\$
(lambda (stream subchar infix)
(declare (ignore subchar infix))
(let ((form1 (read stream)))
(if (symbolp form1)
(list '$ (list (concatenate 'string "$" (symbol-name form1)))
(read stream))
(list '$ () form1))))))
;; Note, presently references to upper level variables in nested
;; partials requires tha tthose upper level variables acttually appear
;; in the upper level partials.
;; e.g.
;;
;; #$(mapcar #$$(cons $$x (length $xs)) $xs)
;;
;; is OK but
;;
;; #$(mapcar #$$(cons $$x (length $passed-in-list)) '(1 2 3 4))
;;
;; is not ok.
(defmacro $ ((&optional (prefix "$")) expr)
"Function splicer. A kind of partial evaluation.
Meant to be used in conjunction with the reader macro #$.
E.g.
#$(+ $X 1)
is roughly equivalent to
(LAMBDA ($X) (+ $X 1))
The order of arguments can be controlled by using positional
variables. E.g.
#$(+ $2 $1)
is equivalent to
(LAMBDA ($1 $2) (+ $2 $1))
Limited nestiing is supported. E.g.
#$(MAPCAR #$$(CONS $$INNER (LENGTH $OUTER)) $OUTER)
is equvalent to
(LAMBDA ($OUTER)
(MAPCAR (LAMBDA ($$INNER) (CONS $$INNER (LENGTH $OUTER)))
$OUTER))
However, a variable inside a nested form must actually appear in the
surrounding form.
THIS WONT WORK: #$(+ #$$(* $X $$Y)) because $$Y doesn't appear in the
surrounding form.
"
(let ((new-params (list))
(numeric-params nil))
(labels ((walk (node)
(cond ((and
(consp node)
(consp (car node))
(eq '$ (caar node)))
(walk (cdr node)))
((consp node)
(walk (car node))
(walk (cdr node)))
(t
(when (substitute-var-p node prefix)
(pushnew node new-params))
(when (numeric-var-p node prefix)
(setf numeric-params t))))))
(walk expr))
(setf new-params
(if numeric-params
(sort new-params #'<
:key (lambda (var)
(parse-integer (symbol-name var)
:junk-allowed t
:start (length prefix))))
(reverse new-params)))
`(lambda ,new-params ,expr)))
(defmacro closure (&body body)
"Creates a lambda that accepts any number of arguments, all of which
are ignored."
(let ((args (gensym)))
`(lambda (&rest ,args)
(declare (ignorable ,args))
,@body)))
|
