1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-23 20:05:32 +02:00

Allow callk to continue to kargs

* module/language/cps/verify.scm (check-arities): If a callk continues
to kargs, the caller knows the number of return values that the callee
provides and no number-of-values check is needed.
* module/language/cps/contification.scm (apply-contification): Allow
contification of known-return-values calls.
* module/language/cps/reify-primitives.scm (uniquify-receive)
(reify-primitives): No need for uniquify-receive any more as receive
shuffles are attached to the call, not the continuation.
* module/language/cps/compile-bytecode.scm (compile-function): Add kargs
case.
This commit is contained in:
Andy Wingo 2021-11-15 10:39:04 +01:00
parent 4fcd643adb
commit 5c76381625
5 changed files with 23 additions and 30 deletions

View file

@ -102,16 +102,6 @@
(letk kclause ($kclause ('() '() #f '() #f) kbody #f))
kclause))
;; A $kreceive continuation should have only one predecessor.
(define (uniquify-receive cps k)
(match (intmap-ref cps k)
(($ $kreceive ($ $arity req () rest () #f) kargs)
(with-cps cps
(letk k ($kreceive req rest kargs))
k))
(_
(with-cps cps k))))
(define (wrap-unary cps k src wrap unwrap op param a)
(with-cps cps
(letv a* res*)
@ -619,16 +609,6 @@
((imm-s64-< (s12? a) b) load-s64 (s64-< a b))
((eq-constant? (imm16? b) a) load-const (eq? a b))
(_ cps))))
(($ $kargs names vars ($ $continue k src ($ $call proc args)))
(with-cps cps
(let$ k (uniquify-receive k))
(setk label ($kargs names vars
($continue k src ($call proc args))))))
(($ $kargs names vars ($ $continue k src ($ $callk k* proc args)))
(with-cps cps
(let$ k (uniquify-receive k))
(setk label ($kargs names vars
($continue k src ($callk k* proc args))))))
(_ cps)))
(with-fresh-name-state cps