summaryrefslogtreecommitdiff
path: root/module/language/cps/contification.scm
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2021-05-25 13:48:23 +0200
committerAndy Wingo <wingo@pobox.com>2023-08-17 14:16:12 +0200
commitdc4fe9741f5556463975ce43292891f103c4fb05 (patch)
tree2bd48c7c74e2b0c294bbab34ae128d9e9597544c /module/language/cps/contification.scm
parentf8b16076022aa871baafa663969362970434f15f (diff)
downloadguile-dc4fe9741f5556463975ce43292891f103c4fb05.tar.gz
Add new $calli expression type.
* module/language/cps.scm ($calli): New expression type which calls a function entry as originally captured via $code. Adapt all callers.
Diffstat (limited to 'module/language/cps/contification.scm')
-rw-r--r--module/language/cps/contification.scm12
1 files changed, 10 insertions, 2 deletions
diff --git a/module/language/cps/contification.scm b/module/language/cps/contification.scm
index 5167e4d3a..285cf746a 100644
--- a/module/language/cps/contification.scm
+++ b/module/language/cps/contification.scm
@@ -206,8 +206,12 @@ $call, and are always called with a compatible arity."
(match cont
(($ $kargs _ _ ($ $continue _ _ exp))
(match exp
- ((or ($ $const) ($ $prim) ($ $const-fun) ($ $code) ($ $fun) ($ $rec))
+ ((or ($ $const) ($ $prim) ($ $fun) ($ $rec))
functions)
+ (($ $const-fun kfun)
+ (intmap-remove functions kfun))
+ (($ $code kfun)
+ (intmap-remove functions kfun))
(($ $values args)
(exclude-vars functions args))
(($ $call proc args)
@@ -226,6 +230,10 @@ $call, and are always called with a compatible arity."
(restrict-arity functions proc (length args))))
(($ $callk k proc args)
(exclude-vars functions (if proc (cons proc args) args)))
+ (($ $calli args callee)
+ ;; While callee is a var and not a label, it is a var that
+ ;; holds a code label, not a function value.
+ (exclude-vars functions args))
(($ $primcall name param args)
(exclude-vars functions args))))
(($ $kargs _ _ ($ $branch kf kt src op param args))
@@ -466,7 +474,7 @@ function set."
(match (intmap-ref conts k*)
(($ $kreceive ($ $arity req () rest () #f) kargs)
(match exp
- ((or ($ $call) ($ $callk))
+ ((or ($ $call) ($ $callk) ($ $calli))
(with-cps cps (build-term ($continue k* src ,exp))))
;; We need to punch through the $kreceive; otherwise we'd
;; have to rewrite as a call to the 'values primitive.