diff options
author | Andy Wingo <wingo@pobox.com> | 2021-05-25 13:48:23 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2023-08-17 14:16:12 +0200 |
commit | dc4fe9741f5556463975ce43292891f103c4fb05 (patch) | |
tree | 2bd48c7c74e2b0c294bbab34ae128d9e9597544c /module/language/cps/contification.scm | |
parent | f8b16076022aa871baafa663969362970434f15f (diff) | |
download | guile-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.scm | 12 |
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. |