summaryrefslogtreecommitdiff
path: root/module/language
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2012-03-03 21:46:38 +0100
committerAndy Wingo <wingo@pobox.com>2012-03-03 21:46:38 +0100
commitd5dbe0c1d5c0d53a652285ca565fa6c30a668f7f (patch)
tree6622edaaaa1003997122f1db7b54cf8b8ff8e648 /module/language
parentdeaae8e9d7cbd0f8fc794fab5f4b4923d432ced0 (diff)
downloadguile-d5dbe0c1d5c0d53a652285ca565fa6c30a668f7f.tar.gz
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.
Diffstat (limited to 'module/language')
-rw-r--r--module/language/tree-il/compile-glil.scm24
1 files changed, 24 insertions, 0 deletions
diff --git a/module/language/tree-il/compile-glil.scm b/module/language/tree-il/compile-glil.scm
index 81defa167..4b9446250 100644
--- a/module/language/tree-il/compile-glil.scm
+++ b/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))