3 (def-ir1-translator compiler-let
((bindings &rest forms
) start next result
)
4 (loop for binding in bindings
6 collect binding into vars
7 and collect nil into values
8 else do
(assert (proper-list-of-length-p binding
1 2))
9 and collect
(first binding
) into vars
10 and collect
(eval (second binding
)) into values
11 finally
(return (progv vars values
12 (sb-c::ir1-convert-progn-body start next result forms
)))))
14 (defun walk-compiler-let (form context env
)
15 (declare (ignore context
))
16 (destructuring-bind (bindings &rest body
)
18 (loop for binding in bindings
20 collect binding into vars
21 and collect nil into values
22 else do
(assert (proper-list-of-length-p binding
1 2))
23 and collect
(first binding
) into vars
24 and collect
(eval (second binding
)) into values
27 (let ((walked-body (sb-walker::walk-repeat-eval body env
)))
28 (sb-walker::relist
* form
29 'compiler-let bindings walked-body
)))))))
31 (sb-walker::define-walker-template compiler-let walk-compiler-let
)
34 (setf (getf sb-eval
::*eval-dispatch-functions
* 'compiler-let
)
36 (destructuring-bind (bindings &body body
) (cdr form
)
37 (loop for binding in bindings
39 collect binding into vars
40 and collect nil into values
41 else do
(assert (proper-list-of-length-p binding
1 2))
42 and collect
(first binding
) into vars
43 and collect
(eval (second binding
)) into values
45 (let ((new-env (sb-eval::make-env
47 :vars
(sb-eval::special-bindings vars env
))))
49 (sb-eval::eval-progn body new-env
))))))))
52 (sb-interpreter::defspecial compiler-let
(bindings &body body
)
54 (funcall sb-interpreter
::*let-processor
*
57 ,@(mapcar (lambda (binding)
58 (if (atom binding
) binding
(car binding
)))