mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-24 12:20:20 +02:00
Code Activity

Add "pop" field to $prompt

Browse source 
* module/language/cps.scm ($prompt): Add a "pop" field, indicating the
  continuation at which this prompt is popped.  The body of the prompt
  is dominated by the prompt, and post-dominated by the pop.  Adapt all
  builders and users.

* module/language/cps/closure-conversion.scm:
* module/language/cps/compile-rtl.scm:
* module/language/cps/slot-allocation.scm:
* module/language/cps/verify.scm:
* module/language/tree-il/compile-cps.scm: Adapt.

* module/language/cps/dfg.scm (visit-fun): Add an arc from the pop to
  the handler, to keep handler variables alive through the prompt body.
This commit is contained in:
Andy Wingo 2013-10-29 22:57:29 +01:00
parent 2700f19833
commit 96af4a18b8
7 changed files with 31 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

16
module/language/cps.scm
View file

@ -85,7 +85,8 @@
;;; - $prompt continues to the body of the prompt, having pushed on a
;;; prompt whose handler will continue at its "handler"
;;; continuation. The continuation of the prompt is responsible for
;;; popping the prompt.
;;; popping the prompt. A $prompt also records the continuation
;;; that pops the prompt, to make various static analyses easier.
;;;
;;; In summary:
;;;
@ -185,7 +186,7 @@
(define-cps-type $call proc args)
(define-cps-type $primcall name args)
(define-cps-type $values args)
(define-cps-type $prompt escape? tag handler)
(define-cps-type $prompt escape? tag handler pop)
(define-syntax let-gensyms
(syntax-rules ()
@ -240,7 +241,8 @@
((_ ($primcall name args)) (make-$primcall name args))
((_ ($values (arg ...))) (make-$values (list arg ...)))
((_ ($values args)) (make-$values args))
((_ ($prompt escape? tag handler)) (make-$prompt escape? tag handler))))
((_ ($prompt escape? tag handler pop))
(make-$prompt escape? tag handler pop))))
(define-syntax build-cps-term
(syntax-rules (unquote $letk $letk* $letconst $letrec $continue)
@ -340,8 +342,8 @@
(build-cps-exp ($primcall name arg)))
(('values arg ...)
(build-cps-exp ($values arg)))
(('prompt escape? tag handler)
(build-cps-exp ($prompt escape? tag handler)))
(('prompt escape? tag handler pop)
(build-cps-exp ($prompt escape? tag handler pop)))
(_
(error "unexpected cps" exp))))
@ -398,8 +400,8 @@
`(primcall ,name ,@args))
(($ $values args)
`(values ,@args))
(($ $prompt escape? tag handler)
`(prompt ,escape? ,tag ,handler))
(($ $prompt escape? tag handler pop)
`(prompt ,escape? ,tag ,handler ,pop))
(_
(error "unexpected cps" exp))))