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:
parent
7c9e477b82
commit
2f08838cd6
6 changed files with 7 additions and 17 deletions
|
@ -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
|
||||
|
|
|
@ -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)))))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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))))
|
||||
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue