X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-cltl2%2Fcompiler-let.lisp;h=e7458dde4bf9f40b68eb09113b27a363c0eb9199;hb=1656e5415acddf6655569b8332e138c36640c08a;hp=60600b52f4123d0bec08fa5fdb55c81a7bbc8ccd;hpb=79f9319b412fc6106d65ca435b36548f454b81b9;p=sbcl.git

diff --git a/contrib/sb-cltl2/compiler-let.lisp b/contrib/sb-cltl2/compiler-let.lisp
index 60600b5..e7458dd 100644
--- a/contrib/sb-cltl2/compiler-let.lisp
+++ b/contrib/sb-cltl2/compiler-let.lisp
@@ -1,6 +1,6 @@
 (in-package :sb-cltl2)
 
-(def-ir1-translator compiler-let ((bindings &rest forms) start cont)
+(def-ir1-translator compiler-let ((bindings &rest forms) start next result)
   (loop for binding in bindings
      if (atom binding)
         collect binding into vars
@@ -9,7 +9,7 @@
         and collect (first binding) into vars
         and collect (eval (second binding)) into values
      finally (return (progv vars values
-                       (sb-c::ir1-convert-progn-body start cont forms)))))
+                       (sb-c::ir1-convert-progn-body start next result forms)))))
 
 (defun walk-compiler-let (form context env)
   (declare (ignore context))
@@ -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))))))))