summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2010-02-22 20:29:10 +0100
committerAndy Wingo <wingo@pobox.com>2010-02-22 21:54:00 +0100
commitf828ab4f30b974c0f839fb6df9590c16907b7a0a (patch)
treeb2fe4499c37029d07bfe493ae1f0f92f471f1ba5
parent47ae4ac8f478b09bc33ab05d896826bc8f6dd2f1 (diff)
downloadguile-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.scm26
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))