1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-23 20:05:32 +02:00

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.
This commit is contained in:
Andy Wingo 2012-03-03 21:46:38 +01:00
parent deaae8e9d7
commit d5dbe0c1d5
3 changed files with 28 additions and 18 deletions

View file

@ -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))