1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 21:40:33 +02:00

Replace return primcalls with $values

* module/language/cps/compile-bytecode.scm:
* module/language/cps/contification.scm:
* module/language/cps/slot-allocation.scm:
* module/language/cps/type-fold.scm:
* module/language/cps/verify.scm:
* module/language/tree-il/compile-cps.scm: Never generate a return
  primcall.  Instead use $values.
This commit is contained in:
Andy Wingo 2015-10-28 11:11:23 +00:00
parent 7c9e477b82
commit 2f08838cd6
6 changed files with 7 additions and 17 deletions

View file

@ -136,9 +136,7 @@
(for-each (match-lambda
((src . dst) (emit-mov asm (from-sp dst) (from-sp src))))
(lookup-parallel-moves label allocation))
(emit-return-values asm (1+ (length args))))
(($ $primcall 'return (arg))
(emit-return asm (from-sp (slot arg))))))
(emit-return-values asm (1+ (length args))))))
(define (compile-value label exp dst)
(match exp

View file

@ -415,12 +415,9 @@ function set."
,(match (intmap-ref conts k*)
(($ $kreceive)
(match exp
(($ $primcall 'return (val))
(build-exp ($primcall 'values (val))))
(($ $call) exp)
;; Except for 'return, a primcall that can continue
;; to $ktail can also continue to $kreceive. TODO:
;; replace 'return with 'values, for consistency.
;; A primcall that can continue to $ktail can also
;; continue to $kreceive.
(($ $primcall) exp)
(($ $values vals)
(build-exp ($primcall 'values vals)))))

View file

@ -660,9 +660,6 @@ are comparable with eqv?. A tmp slot may be used."
(call-size label (1+ (length args)) size))
(($ $values args)
(shuffle-size (get-shuffles label) size))
(($ $primcall 'return (arg))
;; Return will shuffle arg into fp-relative slot 1.
(max size 2))
(_ size)))))
(($ $kreceive)
(values frame-sizes clause

View file

@ -276,7 +276,7 @@
(with-cps cps
(letv bool)
(letk kbool ($kargs (#f) (bool)
($continue k src ($primcall 'return (bool)))))
($continue k src ($values (bool)))))
($ (convert-to-logtest kbool)))))
(with-cps cps #f))))

View file

@ -258,9 +258,7 @@ definitions that are available at LABEL."
(when (false-if-exception (prim-arity name))
(error "primitive should continue to $kargs, not $kreceive" name)))
(($ $ktail)
(unless (eq? name 'return)
(when (false-if-exception (prim-arity name))
(error "primitive should continue to $kargs, not $ktail" name))))))
(error "primitive should continue to $kargs, not $ktail" name))))
(($ $prompt escape? tag handler)
(assert-nullary)
(match (intmap-ref conts handler)

View file

@ -249,7 +249,7 @@
(with-cps cps
(let$ body (with-cps-constants ((unspecified *unspecified*))
(build-term
($continue k src ($primcall 'return (unspecified))))))
($continue k src ($values (unspecified))))))
(letk kvoid ($kargs () () ,body))
kvoid))
(($ $kreceive arity kargs)
@ -287,7 +287,7 @@
(with-cps cps
(letv val)
(letk kval ($kargs ('val) (val)
($continue k src ($primcall 'return (val)))))
($continue k src ($values (val)))))
kval))
(($ $kreceive arity kargs)
(match arity