optimize dynamic-wind when we know winders are thunks

* libguile/vm-i-system.c (wind):
* module/language/tree-il/compile-glil.scm (flatten-lambda-case):
  Instead of making `wind' call `scm_thunk_p' on the winder and unwinder
  at runtime, make it the responsibility of the compiler to emit code to
  call thunk? and error, but only if the compiler cannot prove them to
  be thunks.

* libguile/vm-engine.c (vm_engine): Remove a now-unused error block.

libguile/vm-engine.c

@@ -1,4 +1,4 @@
-/* Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -251,12 +251,6 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
     /* shouldn't get here */
     goto vm_error;
 
-  vm_error_not_a_thunk:
-    SYNC_ALL ();
-    scm_wrong_type_arg_msg ("dynamic-wind", 1, finish_args, "thunk");
-    /* shouldn't get here */
-    goto vm_error;
-
   vm_error_no_values:
     err_msg  = scm_from_latin1_string ("Zero values returned to single-valued continuation");
     finish_args = SCM_EOL;

libguile/vm-i-system.c

@@ -1616,17 +1616,9 @@ VM_DEFINE_INSTRUCTION (86, wind, "wind", 0, 2, 0)
   SYNC_REGISTER ();
   /* Push wind and unwind procedures onto the dynamic stack. Note that neither
      are actually called; the compiler should emit calls to wind and unwind for
-     the normal dynamic-wind control flow. */
+     the normal dynamic-wind control flow.  Also note that the compiler
-  if (SCM_UNLIKELY (scm_is_false (scm_thunk_p (wind))))
+     should have inserted checks that they wind and unwind procs are
-    {
+     thunks, if it could not prove that to be the case.  */
-      finish_args = wind;
-      goto vm_error_not_a_thunk;
-    }
-  if (SCM_UNLIKELY (scm_is_false (scm_thunk_p (unwind))))
-    {
-      finish_args = unwind;
-      goto vm_error_not_a_thunk;
-    }
   scm_dynstack_push_dynwind (&current_thread->dynstack, wind, unwind);
   NEXT;
 }

module/language/tree-il/compile-glil.scm

@@ -921,7 +921,31 @@
       ;; then proceed with returning or dropping or what-have-you, interacting
       ;; with RA and MVRA. What have you, I say.
       ((<dynwind> src winder pre body post unwinder)
+       (define (thunk? x)
+         (and (lambda? x)
+              (null? (lambda-case-gensyms (lambda-body x)))))
+       (define (make-wrong-type-arg x)
+         (make-primcall src 'scm-error
+                        (list
+                         (make-const #f 'wrong-type-arg)
+                         (make-const #f "dynamic-wind")
+                         (make-const #f "Wrong type (expecting thunk): ~S")
+                         (make-primcall #f 'list (list x))
+                         (make-primcall #f 'list (list x)))))
+       (define (emit-thunk-check x)
+         (comp-drop (make-conditional
+                     src
+                     (make-primcall src 'thunk? (list x))
+                     (make-void #f)
+                     (make-wrong-type-arg x))))
+
+       ;; We know at this point that `winder' and `unwinder' are
+       ;; constant expressions and can be duplicated.
+       (if (not (thunk? winder))
+           (emit-thunk-check winder))
        (comp-push winder)
+       (if (not (thunk? unwinder))
+           (emit-thunk-check unwinder))
        (comp-push unwinder)
        (comp-drop pre)
        (emit-code #f (make-glil-call 'wind 2))