mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 05:50:26 +02:00
Code Activity

Remove "pop" from $prompt

Browse source 
* module/language/cps.scm:
* module/language/cps/closure-conversion.scm:
* module/language/cps/compile-bytecode.scm:
* module/language/cps/dfg.scm:
* module/language/cps/slot-allocation.scm:
* module/language/cps/verify.scm:
* module/language/tree-il/compile-cps.scm: Remove "pop" member from
  $prompt data type, as it is no longer used.
This commit is contained in:
Andy Wingo 2014-01-09 19:52:58 +01:00
parent 146ce52d21
commit 7ab76a830b
7 changed files with 24 additions and 26 deletions
Download patch file Download diff file Expand all files Collapse all files

19
module/language/cps.scm
View file

@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL) ;;; Continuation-passing style (CPS) intermediate language (IL)
;; Copyright (C) 2013 Free Software Foundation, Inc. ;; Copyright (C) 2013, 2014 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -85,8 +85,7 @@
;;; - $prompt continues to the body of the prompt, having pushed on a ;;; - $prompt continues to the body of the prompt, having pushed on a
;;; prompt whose handler will continue at its "handler" ;;; prompt whose handler will continue at its "handler"
;;; continuation. The continuation of the prompt is responsible for ;;; continuation. The continuation of the prompt is responsible for
;;; popping the prompt. A $prompt also records the continuation ;;; popping the prompt.
;;; that pops the prompt, to make various static analyses easier.
;;; ;;;
;;; In summary: ;;; In summary:
;;; ;;;
@ -185,7 +184,7 @@
(define-cps-type $call proc args) (define-cps-type $call proc args)
(define-cps-type $primcall name args) (define-cps-type $primcall name args)
(define-cps-type $values args) (define-cps-type $values args)
(define-cps-type $prompt escape? tag handler pop) (define-cps-type $prompt escape? tag handler)
(define-syntax let-gensyms (define-syntax let-gensyms
(syntax-rules () (syntax-rules ()
@ -240,8 +239,8 @@
((_ ($primcall name args)) (make-$primcall name args)) ((_ ($primcall name args)) (make-$primcall name args))
((_ ($values (arg ...))) (make-$values (list arg ...))) ((_ ($values (arg ...))) (make-$values (list arg ...)))
((_ ($values args)) (make-$values args)) ((_ ($values args)) (make-$values args))
((_ ($prompt escape? tag handler pop)) ((_ ($prompt escape? tag handler))
(make-$prompt escape? tag handler pop)))) (make-$prompt escape? tag handler))))
(define-syntax build-cps-term (define-syntax build-cps-term
(syntax-rules (unquote $letk $letk* $letconst $letrec $continue) (syntax-rules (unquote $letk $letk* $letconst $letrec $continue)
@ -341,8 +340,8 @@
(build-cps-exp ($primcall name arg))) (build-cps-exp ($primcall name arg)))
(('values arg ...) (('values arg ...)
(build-cps-exp ($values arg))) (build-cps-exp ($values arg)))
(('prompt escape? tag handler pop) (('prompt escape? tag handler)
(build-cps-exp ($prompt escape? tag handler pop))) (build-cps-exp ($prompt escape? tag handler)))
(_ (_
(error "unexpected cps" exp)))) (error "unexpected cps" exp))))
@ -397,8 +396,8 @@
`(primcall ,name ,@args)) `(primcall ,name ,@args))
(($ $values args) (($ $values args)
`(values ,@args)) `(values ,@args))
(($ $prompt escape? tag handler pop) (($ $prompt escape? tag handler)
`(prompt ,escape? ,tag ,handler ,pop)) `(prompt ,escape? ,tag ,handler))
(_ (_
(error "unexpected cps" exp)))) (error "unexpected cps" exp))))

6
module/language/cps/closure-conversion.scm
View file

@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL) ;;; Continuation-passing style (CPS) intermediate language (IL)
;; Copyright (C) 2013 Free Software Foundation, Inc. ;; Copyright (C) 2013, 2014 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -212,12 +212,12 @@ convert functions to flat closures."
($continue k src ($values args))) ($continue k src ($values args)))
'())))) '()))))
(($ $continue k src ($ $prompt escape? tag handler pop)) (($ $continue k src ($ $prompt escape? tag handler))
(convert-free-var (convert-free-var
tag self bound tag self bound
(lambda (tag) (lambda (tag)
(values (build-cps-term (values (build-cps-term
($continue k src ($prompt escape? tag handler pop))) ($continue k src ($prompt escape? tag handler)))
'())))) '()))))
(_ (error "what" exp)))) (_ (error "what" exp))))

4
module/language/cps/compile-bytecode.scm
View file

@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL) ;;; Continuation-passing style (CPS) intermediate language (IL)
;; Copyright (C) 2013 Free Software Foundation, Inc. ;; Copyright (C) 2013, 2014 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -325,7 +325,7 @@
(define (compile-effect label exp k nlocals) (define (compile-effect label exp k nlocals)
(match exp (match exp
(($ $values ()) #f) (($ $values ()) #f)
(($ $prompt escape? tag handler pop) (($ $prompt escape? tag handler)
(match (lookup-cont handler) (match (lookup-cont handler)
(($ $ktrunc ($ $arity req () rest () #f) khandler-body) (($ $ktrunc ($ $arity req () rest () #f) khandler-body)
(let ((receive-args (gensym "handler")) (let ((receive-args (gensym "handler"))

2
module/language/cps/dfg.scm
View file

@ -845,7 +845,7 @@ BODY for each body continuation in the prompt."
(($ $values args) (($ $values args)
(for-each use! args)) (for-each use! args))
(($ $prompt escape? tag handler pop) (($ $prompt escape? tag handler)
(use! tag) (use! tag)
(use-k! handler)) (use-k! handler))

6
module/language/cps/slot-allocation.scm
View file

@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL) ;;; Continuation-passing style (CPS) intermediate language (IL)
;; Copyright (C) 2013 Free Software Foundation, Inc. ;; Copyright (C) 2013, 2014 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -348,7 +348,7 @@ are comparable with eqv?. A tmp slot may be used."
args) args)
(($ $values args) (($ $values args)
args) args)
(($ $prompt escape? tag handler pop) (($ $prompt escape? tag handler)
(list tag)) (list tag))
(_ '()))))) (_ '())))))
(_ #f)) (_ #f))
@ -607,7 +607,7 @@ are comparable with eqv?. A tmp slot may be used."
(($ $continue k src ($ $values (_ _ . _))) (($ $continue k src ($ $values (_ _ . _)))
(allocate-values label k uses live post-live)) (allocate-values label k uses live post-live))
(($ $continue k src ($ $values)) #t) (($ $continue k src ($ $values)) #t)
(($ $continue k src ($ $prompt escape? tag handler pop)) (($ $continue k src ($ $prompt escape? tag handler))
(allocate-prompt label k handler nargs)) (allocate-prompt label k handler nargs))
(_ #f))) (_ #f)))
(lp (1+ n) post-live)) (lp (1+ n) post-live))

7
module/language/cps/verify.scm
View file

@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL) ;;; Continuation-passing style (CPS) intermediate language (IL)
;; Copyright (C) 2013 Free Software Foundation, Inc. ;; Copyright (C) 2013, 2014 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -128,11 +128,10 @@
(for-each (cut check-var <> v-env) arg)) (for-each (cut check-var <> v-env) arg))
(($ $values ((? symbol? arg) ...)) (($ $values ((? symbol? arg) ...))
(for-each (cut check-var <> v-env) arg)) (for-each (cut check-var <> v-env) arg))
(($ $prompt escape? tag handler pop) (($ $prompt escape? tag handler)
(unless (boolean? escape?) (error "escape? should be boolean" escape?)) (unless (boolean? escape?) (error "escape? should be boolean" escape?))
(check-var tag v-env) (check-var tag v-env)
(check-var handler k-env) (check-var handler k-env))
(check-var pop k-env))
(_ (_
(error "unexpected expression" exp)))) (error "unexpected expression" exp))))

6
module/language/tree-il/compile-cps.scm
View file

@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL) ;;; Continuation-passing style (CPS) intermediate language (IL)
;; Copyright (C) 2013 Free Software Foundation, Inc. ;; Copyright (C) 2013, 2014 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -447,7 +447,7 @@
(build-cps-term (build-cps-term
($letk ((kbody ($kargs () () ($letk ((kbody ($kargs () ()
,(convert body krest subst)))) ,(convert body krest subst))))
($continue kbody src ($prompt #t tag khargs kpop)))) ($continue kbody src ($prompt #t tag khargs))))
(convert-arg body (convert-arg body
(lambda (thunk) (lambda (thunk)
(build-cps-term (build-cps-term
@ -456,7 +456,7 @@
($primcall 'call-thunk/no-inline ($primcall 'call-thunk/no-inline
(thunk)))))) (thunk))))))
($continue kbody (tree-il-src body) ($continue kbody (tree-il-src body)
($prompt #f tag khargs kpop)))))))))))))) ($prompt #f tag khargs))))))))))))))
;; Eta-convert prompts without inline handlers. ;; Eta-convert prompts without inline handlers.
(($ <prompt> src escape-only? tag body handler) (($ <prompt> src escape-only? tag body handler)