X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-cltl2%2Fcompiler-let.lisp;h=e7458dde4bf9f40b68eb09113b27a363c0eb9199;hb=920b5eb02b1e1fd1c6c28395cade04e81fbee2bb;hp=932b4cb5e73e138b72dda367b8d0739a1be25736;hpb=57e21c4b62e8c1a1ee7ef59ed2abb0c864fb06bc;p=sbcl.git diff --git a/contrib/sb-cltl2/compiler-let.lisp b/contrib/sb-cltl2/compiler-let.lisp index 932b4cb..e7458dd 100644 --- a/contrib/sb-cltl2/compiler-let.lisp +++ b/contrib/sb-cltl2/compiler-let.lisp @@ -29,3 +29,21 @@ 'compiler-let bindings walked-body))))))) (sb-walker::define-walker-template compiler-let walk-compiler-let) + +#+sb-eval +(setf (getf sb-eval::*eval-dispatch-functions* 'compiler-let) + (lambda (form env) + (destructuring-bind (bindings &body body) (cdr form) + (loop for binding in bindings + if (atom binding) + collect binding into vars + and collect nil into values + else do (assert (proper-list-of-length-p binding 1 2)) + and collect (first binding) into vars + and collect (eval (second binding)) into values + finally (return + (let ((new-env (sb-eval::make-env + :parent env + :vars (sb-eval::special-bindings vars env)))) + (progv vars values + (sb-eval::eval-progn body new-env))))))))