[Sbcl-commits] CVS: sbcl/contrib/sb-cltl2 compiler-let.lisp, 1.2, 1.3

[Juho S. <js...@us...>]

Update of /cvsroot/sbcl/sbcl/contrib/sb-cltl2
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv10189/contrib/sb-cltl2

Modified Files:
	compiler-let.lisp 
Log Message:
0.9.16.27:
        Add an interpreting EVAL, for cases where the compiler is
        unsuitable due to e.g. compilation overhead.

        * The old EVAL is still the default. To use the new one, 
          (SETF SB-EXT:*EVALUATOR-MODE* :INTERPRET).

          Making the interpreter the default might be the purer
          choice, since there's a standard way of ensuring that code
          is compiled, and no standard way of ensuring that it's
          not. On the other hand, there are practical reasons for
          keeping the compiler as the default. The interpreter is very
          slow, doesn't have proper debugger support (either for
          backtraces or inspecting frames), and it doesn't have
          stepper support. 

        * The interpreter doesn't treat THE or type declarations for
          lexical variables as assertions. The regression tests that
          assume otherwise have been disabled when running in
          interpreted mode. The intepreter will however type-check the
          proclaimed types of specials.



Index: compiler-let.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/contrib/sb-cltl2/compiler-let.lisp,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- compiler-let.lisp	15 Sep 2003 09:21:38 -0000	1.2
+++ compiler-let.lisp	13 Sep 2006 15:59:32 -0000	1.3
@@ -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))))
+                            (progv vars values
+                              (sb-eval::eval-progn body new-env))))))))