0.8.3.71:
[sbcl/lichteblau.git] / contrib / sb-cltl2 / compiler-let.lisp
blob932b4cb5e73e138b72dda367b8d0739a1be25736
1 (in-package :sb-cltl2)
3 (def-ir1-translator compiler-let ((bindings &rest forms) start next result)
4 (loop for binding in bindings
5 if (atom binding)
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)
17 (cdr form)
18 (loop for binding in bindings
19 if (atom binding)
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
25 finally (return
26 (progv vars 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)