diff options
author | Andy Wingo <wingo@pobox.com> | 2012-03-03 21:46:38 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2012-03-03 21:46:38 +0100 |
commit | d5dbe0c1d5c0d53a652285ca565fa6c30a668f7f (patch) | |
tree | 6622edaaaa1003997122f1db7b54cf8b8ff8e648 /module/language | |
parent | deaae8e9d7cbd0f8fc794fab5f4b4923d432ced0 (diff) | |
download | guile-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.scm | 24 |
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)) |