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

Remove $void CPS expression type

Browse source 
* module/language/cps.scm: Remove the $void expression type, replaced by
  $const of the unspecified value.
* module/language/cps/arities.scm:
* module/language/cps/closure-conversion.scm:
* module/language/cps/compile-bytecode.scm:
* module/language/cps/cse.scm:
* module/language/cps/dce.scm:
* module/language/cps/dfg.scm:
* module/language/cps/effects-analysis.scm:
* module/language/cps/reify-primitives.scm:
* module/language/cps/renumber.scm:
* module/language/cps/self-references.scm:
* module/language/cps/simplify.scm:
* module/language/cps/slot-allocation.scm:
* module/language/cps/specialize-primcalls.scm:
* module/language/cps/types.scm:
* module/language/cps/verify.scm:
* module/language/tree-il/compile-cps.scm: Update callers.
This commit is contained in:
Andy Wingo 2015-03-11 21:51:33 +01:00
parent 1f3babaaef
commit a9ec16f9c5
17 changed files with 33 additions and 47 deletions
Download patch file Download diff file Expand all files Collapse all files

12
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, 2014 Free Software Foundation, Inc. ;; Copyright (C) 2013, 2014, 2015 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
@ -122,7 +122,7 @@
$kreceive $kargs $kfun $ktail $kclause $kreceive $kargs $kfun $ktail $kclause
;; Expressions. ;; Expressions.
$void $const $prim $fun $closure $branch $const $prim $fun $closure $branch
$call $callk $primcall $values $prompt $call $callk $primcall $values $prompt
;; First-order CPS root. ;; First-order CPS root.
@ -188,7 +188,6 @@
(define-cps-type $kclause arity cont alternate) (define-cps-type $kclause arity cont alternate)
;; Expressions. ;; Expressions.
(define-cps-type $void)
(define-cps-type $const val) (define-cps-type $const val)
(define-cps-type $prim name) (define-cps-type $prim name)
(define-cps-type $fun free body) ; Higher-order. (define-cps-type $fun free body) ; Higher-order.
@ -264,10 +263,9 @@
(define-syntax build-cps-exp (define-syntax build-cps-exp
(syntax-rules (unquote (syntax-rules (unquote
$void $const $prim $fun $closure $branch $const $prim $fun $closure $branch
$call $callk $primcall $values $prompt) $call $callk $primcall $values $prompt)
((_ (unquote exp)) exp) ((_ (unquote exp)) exp)
((_ ($void)) (make-$void))
((_ ($const val)) (make-$const val)) ((_ ($const val)) (make-$const val))
((_ ($prim name)) (make-$prim name)) ((_ ($prim name)) (make-$prim name))
((_ ($fun free body)) (make-$fun free (build-cps-cont body))) ((_ ($fun free body)) (make-$fun free (build-cps-cont body)))
@ -380,8 +378,6 @@
;; Calls. ;; Calls.
(('continue k exp) (('continue k exp)
(build-cps-term ($continue k (src exp) ,(parse-cps exp)))) (build-cps-term ($continue k (src exp) ,(parse-cps exp))))
(('void)
(build-cps-exp ($void)))
(('const exp) (('const exp)
(build-cps-exp ($const exp))) (build-cps-exp ($const exp)))
(('prim name) (('prim name)
@ -441,8 +437,6 @@
;; Calls. ;; Calls.
(($ $continue k src exp) (($ $continue k src exp)
`(continue ,k ,(unparse-cps exp))) `(continue ,k ,(unparse-cps exp)))
(($ $void)
`(void))
(($ $const val) (($ $const val)
`(const ,val)) `(const ,val))
(($ $prim name) (($ $prim name)

13
module/language/cps/arities.scm
View file

@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL) ;;; Continuation-passing style (CPS) intermediate language (IL)
;; Copyright (C) 2013, 2014 Free Software Foundation, Inc. ;; Copyright (C) 2013, 2014, 2015 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
@ -61,7 +61,8 @@
($continue k src ($continue k src
($primcall 'return (unspec))))) ($primcall 'return (unspec)))))
(kvoid ($kargs () () (kvoid ($kargs () ()
($continue kunspec src ($void))))) ($continue kunspec src
($const *unspecified*)))))
($continue kvoid src ,exp))))) ($continue kvoid src ,exp)))))
(($ $kreceive arity kargs) (($ $kreceive arity kargs)
,(match arity ,(match arity
@ -82,14 +83,15 @@
($primcall 'values (void))))) ($primcall 'values (void)))))
(kvoid ($kargs () () (kvoid ($kargs () ()
($continue kvalues src ($continue kvalues src
($void))))) ($const *unspecified*)))))
($continue kvoid src ,exp))))))) ($continue kvoid src ,exp)))))))
(($ $kargs () () _) (($ $kargs () () _)
($continue k src ,exp)) ($continue k src ,exp))
(_ (_
,(let-fresh (k*) () ,(let-fresh (k*) ()
(build-cps-term (build-cps-term
($letk ((k* ($kargs () () ($continue k src ($void))))) ($letk ((k* ($kargs () () ($continue k src
($const *unspecified*)))))
($continue k* src ,exp))))))) ($continue k* src ,exp)))))))
(1 (1
(rewrite-cps-term (lookup-cont k dfg) (rewrite-cps-term (lookup-cont k dfg)
@ -134,8 +136,7 @@
(define (visit-exp k src exp) (define (visit-exp k src exp)
(rewrite-cps-term exp (rewrite-cps-term exp
((or ($ $void) ((or ($ $const)
($ $const)
($ $prim) ($ $prim)
($ $values (_))) ($ $values (_)))
,(adapt-exp 1 k src exp)) ,(adapt-exp 1 k src 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, 2014 Free Software Foundation, Inc. ;; Copyright (C) 2013, 2014, 2015 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
@ -119,7 +119,7 @@
free free
(cons var free))) (cons var free)))
(match exp (match exp
((or ($ $void) ($ $const) ($ $prim)) '()) ((or ($ $const) ($ $prim)) '())
(($ $call proc args) (($ $call proc args)
(for-each clear-well-known! args) (for-each clear-well-known! args)
(fold adjoin (adjoin proc '()) args)) (fold adjoin (adjoin proc '()) args))
@ -448,7 +448,7 @@ bound to @var{var}, and continue with @var{body}."
src var (well-known? kfun) fun-free src var (well-known? kfun) fun-free
body))))))) body)))))))
(($ $continue k src (or ($ $void) ($ $const) ($ $prim))) (($ $continue k src (or ($ $const) ($ $prim)))
term) term)
(($ $continue k src ($ $fun () ($ $cont kfun))) (($ $continue k src ($ $fun () ($ $cont kfun)))

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

@ -250,8 +250,6 @@
(($ $values (arg)) (($ $values (arg))
(or (maybe-load-constant dst arg) (or (maybe-load-constant dst arg)
(maybe-mov dst (slot arg)))) (maybe-mov dst (slot arg))))
(($ $void)
(emit-load-constant asm dst *unspecified*))
(($ $const exp) (($ $const exp)
(emit-load-constant asm dst exp)) (emit-load-constant asm dst exp))
(($ $closure k 0) (($ $closure k 0)

5
module/language/cps/cse.scm
View file

@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL) ;;; Continuation-passing style (CPS) intermediate language (IL)
;; Copyright (C) 2013, 2014 Free Software Foundation, Inc. ;; Copyright (C) 2013, 2014, 2015 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
@ -294,7 +294,6 @@ could be that both true and false proofs are available."
(define (compute-exp-key exp) (define (compute-exp-key exp)
(match exp (match exp
(($ $void) 'void)
(($ $const val) (cons 'const val)) (($ $const val) (cons 'const val))
(($ $prim name) (cons 'prim name)) (($ $prim name) (cons 'prim name))
(($ $fun free body) #f) (($ $fun free body) #f)
@ -462,7 +461,7 @@ could be that both true and false proofs are available."
(define (visit-exp exp) (define (visit-exp exp)
;; We shouldn't see $fun here. ;; We shouldn't see $fun here.
(rewrite-cps-exp exp (rewrite-cps-exp exp
((or ($ $void) ($ $const) ($ $prim)) ,exp) ((or ($ $const) ($ $prim)) ,exp)
(($ $call proc args) (($ $call proc args)
($call (subst-var proc) ,(map subst-var args))) ($call (subst-var proc) ,(map subst-var args)))
(($ $callk k proc args) (($ $callk k proc args)

4
module/language/cps/dce.scm
View file

@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL) ;;; Continuation-passing style (CPS) intermediate language (IL)
;; Copyright (C) 2013, 2014 Free Software Foundation, Inc. ;; Copyright (C) 2013, 2014, 2015 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
@ -205,7 +205,7 @@
(bitvector-set! live-conts n #t))) (bitvector-set! live-conts n #t)))
(when (bitvector-ref live-conts n) (when (bitvector-ref live-conts n)
(match exp (match exp
((or ($ $void) ($ $const) ($ $prim)) ((or ($ $const) ($ $prim))
#f) #f)
(($ $fun free body) (($ $fun free body)
(visit-fun body)) (visit-fun body))

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

@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL) ;;; Continuation-passing style (CPS) intermediate language (IL)
;; Copyright (C) 2013, 2014 Free Software Foundation, Inc. ;; Copyright (C) 2013, 2014, 2015 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
@ -671,7 +671,7 @@ body continuation in the prompt."
(define (use! sym) (define (use! sym)
(add-use! sym label)) (add-use! sym label))
(match exp (match exp
((or ($ $void) ($ $const) ($ $prim) ($ $closure)) #f) ((or ($ $const) ($ $prim) ($ $closure)) #f)
(($ $call proc args) (($ $call proc args)
(use! proc) (use! proc)
(for-each use! args)) (for-each use! args))
@ -766,7 +766,6 @@ body continuation in the prompt."
(format port " k~a k~a\n" kt kf)) (format port " k~a k~a\n" kt kf))
(($ $continue k src exp) (($ $continue k src exp)
(match exp (match exp
(($ $void) (format port "void"))
(($ $const val) (format port "const ~@y" val)) (($ $const val) (format port "const ~@y" val))
(($ $prim name) (format port "prim ~a" name)) (($ $prim name) (format port "prim ~a" name))
(($ $fun free ($ $cont kbody)) (format port "fun k~a" kbody)) (($ $fun free ($ $cont kbody)) (format port "fun k~a" kbody))
@ -842,8 +841,6 @@ body continuation in the prompt."
(match (find-defining-expression sym dfg) (match (find-defining-expression sym dfg)
(($ $const val) (($ $const val)
(values #t val)) (values #t val))
(($ $continue k src ($ $void))
(values #t *unspecified*))
(else (else
(values #f #f)))) (values #f #f))))

2
module/language/cps/effects-analysis.scm
View file

@ -441,7 +441,7 @@ is or might be a read or a write to the same location as A."
(define (expression-effects exp dfg) (define (expression-effects exp dfg)
(match exp (match exp
((or ($ $void) ($ $const) ($ $prim) ($ $values)) ((or ($ $const) ($ $prim) ($ $values))
&no-effects) &no-effects)
(($ $fun) (($ $fun)
(&allocate &unknown-memory-kinds)) (&allocate &unknown-memory-kinds))

3
module/language/cps/reify-primitives.scm
View file

@ -139,7 +139,8 @@
=> (lambda (idx) => (lambda (idx)
(builtin-ref idx k src))) (builtin-ref idx k src)))
(else (primitive-ref name k src))) (else (primitive-ref name k src)))
(build-cps-term ($continue k src ($void))))) (build-cps-term ($continue k src
($const *unspecified*)))))
(($ $primcall 'call-thunk/no-inline (proc)) (($ $primcall 'call-thunk/no-inline (proc))
(build-cps-term (build-cps-term
($continue k src ($call proc ())))) ($continue k src ($call proc ()))))

4
module/language/cps/renumber.scm
View file

@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL) ;;; Continuation-passing style (CPS) intermediate language (IL)
;; Copyright (C) 2014 Free Software Foundation, Inc. ;; Copyright (C) 2014, 2015 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
@ -308,7 +308,7 @@
($continue (relabel k) src ,(visit-exp exp))))) ($continue (relabel k) src ,(visit-exp exp)))))
(define (visit-exp exp) (define (visit-exp exp)
(match exp (match exp
((or ($ $void) ($ $const) ($ $prim)) ((or ($ $const) ($ $prim))
exp) exp)
(($ $closure k nfree) (($ $closure k nfree)
(build-cps-exp ($closure (relabel k) nfree))) (build-cps-exp ($closure (relabel k) nfree)))

4
module/language/cps/self-references.scm
View file

@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL) ;;; Continuation-passing style (CPS) intermediate language (IL)
;; Copyright (C) 2013, 2014 Free Software Foundation, Inc. ;; Copyright (C) 2013, 2014, 2015 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
@ -56,7 +56,7 @@
(define (visit-exp exp) (define (visit-exp exp)
(rewrite-cps-exp exp (rewrite-cps-exp exp
((or ($ $void) ($ $const) ($ $prim)) ,exp) ((or ($ $const) ($ $prim)) ,exp)
(($ $fun free body) (($ $fun free body)
($fun free ,(resolve-self-references body env))) ($fun free ,(resolve-self-references body env)))
(($ $call proc args) (($ $call proc args)

4
module/language/cps/simplify.scm
View file

@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL) ;;; Continuation-passing style (CPS) intermediate language (IL)
;; Copyright (C) 2013, 2014 Free Software Foundation, Inc. ;; Copyright (C) 2013, 2014, 2015 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
@ -238,7 +238,7 @@
(build-cps-term ($continue k src ,(visit-exp exp)))))))) (build-cps-term ($continue k src ,(visit-exp exp))))))))
(define (visit-exp exp) (define (visit-exp exp)
(match exp (match exp
((or ($ $void) ($ $const) ($ $prim)) exp) ((or ($ $const) ($ $prim)) exp)
(($ $fun) (visit-fun exp)) (($ $fun) (visit-fun exp))
(($ $call proc args) (($ $call proc args)
(let ((args (map subst args))) (let ((args (map subst args)))

4
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, 2014 Free Software Foundation, Inc. ;; Copyright (C) 2013, 2014, 2015 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
@ -452,7 +452,7 @@ are comparable with eqv?. A tmp slot may be used."
;; are finished with the scan, we kill uses of the ;; are finished with the scan, we kill uses of the
;; terminator, but leave its definitions. ;; terminator, but leave its definitions.
(match (find-expression body) (match (find-expression body)
((or ($ $void) ($ $const) ($ $prim) ($ $closure) ((or ($ $const) ($ $prim) ($ $closure)
($ $primcall) ($ $prompt) ($ $primcall) ($ $prompt)
;; If $values has more than one argument, it may ;; If $values has more than one argument, it may
;; use a temporary, which would invalidate our ;; use a temporary, which would invalidate our

4
module/language/cps/specialize-primcalls.scm
View file

@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL) ;;; Continuation-passing style (CPS) intermediate language (IL)
;; Copyright (C) 2013, 2014 Free Software Foundation, Inc. ;; Copyright (C) 2013, 2014, 2015 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
@ -73,7 +73,7 @@
($letk ((k* ($kargs ('val) (val) ($letk ((k* ($kargs ('val) (val)
($continue k src ($primcall 'values (val))))) ($continue k src ($primcall 'values (val)))))
(kvoid ($kargs () () (kvoid ($kargs () ()
($continue k* src ($void))))) ($continue k* src ($const *unspecified*)))))
($continue kvoid src exp))))) ($continue kvoid src exp)))))
(define-syntax-rule (adapt-val exp) (define-syntax-rule (adapt-val exp)
(let-fresh (k*) (val) (let-fresh (k*) (val)

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

@ -1276,8 +1276,6 @@ mapping symbols to types."
(match (lookup-cont k dfg) (match (lookup-cont k dfg)
(($ $kargs (_) (var)) (($ $kargs (_) (var))
(let ((entry (match exp (let ((entry (match exp
(($ $void)
(make-type-entry &unspecified -inf.0 +inf.0))
(($ $const val) (($ $const val)
(constant-type val)) (constant-type val))
((or ($ $prim) ($ $fun) ($ $closure)) ((or ($ $prim) ($ $fun) ($ $closure))

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

@ -135,8 +135,6 @@
(define (visit-expression exp k-env v-env) (define (visit-expression exp k-env v-env)
(match exp (match exp
(($ $void)
#t)
(($ $const val) (($ $const val)
#t) #t)
(($ $prim (? symbol? name)) (($ $prim (? symbol? name))

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

@ -253,7 +253,7 @@
(var ($continue k src ($values (var)))))) (var ($continue k src ($values (var))))))
(($ <void> src) (($ <void> src)
(build-cps-term ($continue k src ($void)))) (build-cps-term ($continue k src ($const *unspecified*))))
(($ <const> src exp) (($ <const> src exp)
(build-cps-term ($continue k src ($const exp)))) (build-cps-term ($continue k src ($const exp))))