diff options
author | Andy Wingo <wingo@pobox.com> | 2010-02-22 20:29:10 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2010-02-22 21:54:00 +0100 |
commit | f828ab4f30b974c0f839fb6df9590c16907b7a0a (patch) | |
tree | b2fe4499c37029d07bfe493ae1f0f92f471f1ba5 | |
parent | 47ae4ac8f478b09bc33ab05d896826bc8f6dd2f1 (diff) | |
download | guile-f828ab4f30b974c0f839fb6df9590c16907b7a0a.tar.gz |
prompt and abort inlining
* module/language/tree-il/primitives.scm
(*interesting-primitive-names*): Add abort.
(*primitive-expand-table*): Fix so that we inline `prompt' and
`abort', and remove obsolete code dealing in `control'.
-rw-r--r-- | module/language/tree-il/primitives.scm | 26 |
1 files changed, 21 insertions, 5 deletions
diff --git a/module/language/tree-il/primitives.scm b/module/language/tree-il/primitives.scm index b78339618..f5320db38 100644 --- a/module/language/tree-il/primitives.scm +++ b/module/language/tree-il/primitives.scm @@ -63,7 +63,7 @@ fluid-ref fluid-set! - @prompt prompt + @prompt prompt abort struct? struct-vtable make-struct struct-ref struct-set! @@ -454,13 +454,29 @@ (else #f))) (hashq-set! *primitive-expand-table* - 'control + 'prompt (case-lambda - ((src tag . args) - (make-abort src tag args)) + ((src tag thunk handler) + ;; Sigh. Until the inliner does its job, manually inline + ;; (let ((h (lambda ...))) (prompt k x h)) + (cond + ((lambda? handler) + (let ((args-sym (gensym))) + (make-prompt + src tag (make-application #f thunk '()) + ;; If handler itself is a lambda, the inliner can do some + ;; trickery here. + (make-lambda-case + (tree-il-src handler) '() #f 'args #f '() (list args-sym) + (make-application #f (make-primitive-ref #f 'apply) + (list handler + (make-lexical-ref #f 'args args-sym))) + #f)))) + (else #f))) (else #f))) + (hashq-set! *primitive-expand-table* - '@control + 'abort (case-lambda ((src tag . args) (make-abort src tag args)) |