Merge remote-tracking branch 'origin/stable-2.0'

[bpt/guile.git] / module / language / scheme / decompile-tree-il.scm

diff --git a/module/language/scheme/decompile-tree-il.scm b/module/language/scheme/decompile-tree-il.scm
index c065474..99edee4 100644 (file)
--- a/module/language/scheme/decompile-tree-il.scm
+++ b/module/language/scheme/decompile-tree-il.scm
@@ -432,27 +432,12 @@
          `(call-with-values (lambda () ,@(recurse-body exp))
             ,(recurse (make-lambda #f '() body))))
 
-        ((<dynwind> body winder unwinder)
-         `(dynamic-wind ,(recurse winder)
-                        (lambda () ,@(recurse-body body))
-                        ,(recurse unwinder)))
-
-        ((<dynlet> fluids vals body)
-         `(with-fluids ,(map list
-                             (map recurse fluids)
-                             (map recurse vals))
-            ,@(recurse-body body)))
-
-        ((<dynref> fluid)
-         `(fluid-ref ,(recurse fluid)))
-
-        ((<dynset> fluid exp)
-         `(fluid-set! ,(recurse fluid) ,(recurse exp)))
-
-        ((<prompt> tag body handler)
+        ((<prompt> escape-only? tag body handler)
          `(call-with-prompt
            ,(recurse tag)
-           (lambda () ,@(recurse-body body))
+           ,(if escape-only?
+                `(lambda () ,(recurse body))
+                (recurse body))
            ,(recurse handler)))
 
 
@@ -705,7 +690,7 @@
              (primitive 'begin) (recurse head) (recurse tail))
 
             ((<lambda> body)
-             (if body (recurse body)))
+             (if body (recurse body) (primitive 'case-lambda)))
 
             ((<lambda-case> req opt rest kw inits gensyms body alternate)
              (primitive 'lambda)
@@ -761,23 +746,8 @@
              (primitive 'call-with-values)
              (recurse exp) (recurse body))
 
-            ((<dynwind> winder body unwinder)
-             (primitive 'dynamic-wind)
-             (recurse winder) (recurse body) (recurse unwinder))
-
-            ((<dynlet> fluids vals body)
-             (primitive 'with-fluids)
-             (for-each recurse fluids)
-             (for-each recurse vals)
-             (recurse body))
-
-            ((<dynref> fluid) (primitive 'fluid-ref) (recurse fluid))
-            ((<dynset> fluid exp)
-             (primitive 'fluid-set!) (recurse fluid) (recurse exp))
-
             ((<prompt> tag body handler)
              (primitive 'call-with-prompt)
-             (primitive 'lambda)
              (recurse tag) (recurse body) (recurse handler))
 
             ((<abort> tag args tail)