0.8.18.25:
[sbcl.git] / contrib / sb-cltl2 / compiler-let.lisp
1 (in-package :sb-cltl2)
2
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)))))
13
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)))))))
30
31 (sb-walker::define-walker-template compiler-let walk-compiler-let)