[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 04/05: Add new $calli expression type.
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] 04/05: Add new $calli expression type. |
|
Date: |
Wed, 9 Jun 2021 10:47:05 -0400 (EDT) |
wingo pushed a commit to branch wip-tailify
in repository guile.
commit 950638639677842074b63e3789f0b7d7bb84d90c
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Tue May 25 13:48:23 2021 +0200
Add new $calli expression type.
* module/language/cps.scm ($calli): New expression type, calls a label
as a value. Adapt all callers.
---
module/language/cps.scm | 12 ++++++++++--
module/language/cps/closure-conversion.scm | 15 +++++++++++++++
module/language/cps/compile-bytecode.scm | 7 +++++++
module/language/cps/contification.scm | 12 ++++++++++--
module/language/cps/cse.scm | 3 +++
module/language/cps/dce.scm | 2 ++
module/language/cps/devirtualize-integers.scm | 4 +++-
module/language/cps/effects-analysis.scm | 2 +-
module/language/cps/peel-loops.scm | 4 +++-
module/language/cps/reify-primitives.scm | 12 +++++-------
module/language/cps/renumber.scm | 6 +++---
module/language/cps/rotate-loops.scm | 4 +++-
module/language/cps/self-references.scm | 2 ++
module/language/cps/simplify.scm | 4 ++++
module/language/cps/slot-allocation.scm | 16 ++++++++++++++--
module/language/cps/specialize-numbers.scm | 4 +++-
module/language/cps/split-rec.scm | 2 ++
module/language/cps/types.scm | 2 +-
module/language/cps/utils.scm | 2 ++
module/language/cps/verify.scm | 17 +++++++++++++----
20 files changed, 106 insertions(+), 26 deletions(-)
diff --git a/module/language/cps.scm b/module/language/cps.scm
index f83b625..42ebb0f 100644
--- a/module/language/cps.scm
+++ b/module/language/cps.scm
@@ -131,7 +131,7 @@
;; Expressions.
$const $prim $fun $rec $const-fun $code
- $call $callk $primcall $values
+ $call $callk $calli $primcall $values
;; Building macros.
build-cont build-term build-exp
@@ -193,6 +193,7 @@
(define-cps-type $code label) ; First-order.
(define-cps-type $call proc args)
(define-cps-type $callk k proc args) ; First-order.
+(define-cps-type $calli args callee) ; First-order.
(define-cps-type $primcall name param args)
(define-cps-type $values args)
@@ -247,7 +248,7 @@
(define-syntax build-exp
(syntax-rules (unquote
$const $prim $fun $rec $const-fun $code
- $call $callk $primcall $values)
+ $call $callk $calli $primcall $values)
((_ (unquote exp)) exp)
((_ ($const val)) (make-$const val))
((_ ($prim name)) (make-$prim name))
@@ -261,6 +262,9 @@
((_ ($callk k proc (unquote args))) (make-$callk k proc args))
((_ ($callk k proc (arg ...))) (make-$callk k proc (list arg ...)))
((_ ($callk k proc args)) (make-$callk k proc args))
+ ((_ ($calli (unquote args) callee)) (make-$calli args callee))
+ ((_ ($calli (arg ...) callee)) (make-$calli (list arg ...) callee))
+ ((_ ($calli args callee)) (make-$calli args callee))
((_ ($primcall name param (unquote args))) (make-$primcall name param
args))
((_ ($primcall name param (arg ...))) (make-$primcall name param (list arg
...)))
((_ ($primcall name param args)) (make-$primcall name param args))
@@ -328,6 +332,8 @@
(build-exp ($call proc arg)))
(('callk k proc arg ...)
(build-exp ($callk k proc arg)))
+ (('calli arg ... callee)
+ (build-exp ($calli arg callee)))
(('primcall name param arg ...)
(build-exp ($primcall name param arg)))
(('values arg ...)
@@ -383,6 +389,8 @@
`(call ,proc ,@args))
(($ $callk k proc args)
`(callk ,k ,proc ,@args))
+ (($ $calli args callee)
+ `(callk ,@args ,callee))
(($ $primcall name param args)
`(primcall ,name ,param ,@args))
(($ $values args)
diff --git a/module/language/cps/closure-conversion.scm
b/module/language/cps/closure-conversion.scm
index 875552b..a4d09ef 100644
--- a/module/language/cps/closure-conversion.scm
+++ b/module/language/cps/closure-conversion.scm
@@ -76,6 +76,8 @@
(if proc
(add-use proc uses)
uses)))
+ (($ $calli args callee)
+ (add-uses args (add-use callee uses)))
(($ $primcall name param args)
(add-uses args uses))))
(($ $kargs _ _ ($ $branch kf kt src op param args))
@@ -209,6 +211,8 @@ shared closures to use the appropriate 'self' variable, if
possible."
((closure . label) ($callk label closure ,args)))))
(($ $callk label proc args)
($callk label (and proc (subst proc)) ,(map subst args)))
+ (($ $calli args callee)
+ ($calli ,(map subst args) (subst callee)))
(($ $primcall name param args)
($primcall name param ,(map subst args)))
(($ $values args)
@@ -350,6 +354,8 @@ references."
(if proc
(add-use proc uses)
uses)))
+ (($ $calli args callee)
+ (add-uses args (add-use callee uses)))
(($ $primcall name param args)
(add-uses args uses))))
(($ $branch kf kt src op param args)
@@ -797,6 +803,15 @@ bound to @var{var}, and continue to @var{k}."
(($ $continue k src ($ $callk label proc args))
(convert-known-proc-call cps k src label proc args))
+ (($ $continue k src ($ $calli args callee))
+ (convert-args cps args
+ (lambda (cps args)
+ (convert-arg cps callee
+ (lambda (cps callee)
+ (with-cps cps
+ (build-term
+ ($continue k src ($calli args callee)))))))))
+
(($ $continue k src ($ $primcall name param args))
(convert-args cps args
(lambda (cps args)
diff --git a/module/language/cps/compile-bytecode.scm
b/module/language/cps/compile-bytecode.scm
index a2c951d..712472d 100644
--- a/module/language/cps/compile-bytecode.scm
+++ b/module/language/cps/compile-bytecode.scm
@@ -123,6 +123,13 @@
(maybe-reset-frame (+ nclosure (length args))))
(emit-handle-interrupts asm)
(emit-tail-call-label asm k))
+ (($ $calli args callee)
+ (for-each (match-lambda
+ ((src . dst) (emit-mov asm (from-sp dst) (from-sp src))))
+ (lookup-parallel-moves label allocation))
+ (maybe-reset-frame (1+ (length args)))
+ (emit-handle-interrupts asm)
+ (emit-indirect-tail-call asm))
(($ $values args)
(for-each (match-lambda
((src . dst) (emit-mov asm (from-sp dst) (from-sp src))))
diff --git a/module/language/cps/contification.scm
b/module/language/cps/contification.scm
index 8f07f79..b4b0227 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))
@@ -474,7 +482,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.
diff --git a/module/language/cps/cse.scm b/module/language/cps/cse.scm
index 47c0f90..e32270b 100644
--- a/module/language/cps/cse.scm
+++ b/module/language/cps/cse.scm
@@ -473,6 +473,7 @@ for a label, it isn't known to be constant at that label."
(($ $code label) (cons 'code label))
(($ $call proc args) #f)
(($ $callk k proc args) #f)
+ (($ $calli args callee) #f)
(($ $primcall name param args) (cons* name param args))
(($ $values args) #f)))
(define (compute-term-key term)
@@ -551,6 +552,8 @@ for a label, it isn't known to be constant at that label."
($call (subst-var proc) ,(map subst-var args)))
(($ $callk k proc args)
($callk k (and proc (subst-var proc)) ,(map subst-var args)))
+ (($ $calli args callee)
+ ($calli ,(map subst-var args) (subst-var callee)))
(($ $primcall name param args)
($primcall name param ,(map subst-var args)))
(($ $values args)
diff --git a/module/language/cps/dce.scm b/module/language/cps/dce.scm
index 8b06046..7a21be9 100644
--- a/module/language/cps/dce.scm
+++ b/module/language/cps/dce.scm
@@ -160,6 +160,8 @@ sites."
(adjoin-vars args (if proc
(adjoin-var proc live-vars)
live-vars))))
+ (($ $calli args callee)
+ (values live-labels (adjoin-var callee (adjoin-vars args live-vars))))
(($ $primcall name param args)
(values live-labels (adjoin-vars args live-vars)))
(($ $values args)
diff --git a/module/language/cps/devirtualize-integers.scm
b/module/language/cps/devirtualize-integers.scm
index 471ca81..6fa38a3 100644
--- a/module/language/cps/devirtualize-integers.scm
+++ b/module/language/cps/devirtualize-integers.scm
@@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL)
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -71,6 +71,8 @@
(add-uses (add-use use-counts proc) args))
(($ $callk kfun proc args)
(add-uses (if proc (add-use use-counts proc) use-counts) args))
+ (($ $calli args callee)
+ (add-use (add-uses use-counts args) callee))
(($ $primcall name param args)
(add-uses use-counts args))))
(($ $branch kf kt src op param args)
diff --git a/module/language/cps/effects-analysis.scm
b/module/language/cps/effects-analysis.scm
index 365c280..292de86 100644
--- a/module/language/cps/effects-analysis.scm
+++ b/module/language/cps/effects-analysis.scm
@@ -620,7 +620,7 @@ the LABELS that are clobbered by the effects of LABEL."
&no-effects)
((or ($ $fun) ($ $rec))
(&allocate &unknown-memory-kinds))
- ((or ($ $call) ($ $callk))
+ ((or ($ $call) ($ $callk) ($ $calli))
&all-effects)
(($ $primcall name param args)
(primitive-effects param name args))))
diff --git a/module/language/cps/peel-loops.scm
b/module/language/cps/peel-loops.scm
index c28654f..088fee0 100644
--- a/module/language/cps/peel-loops.scm
+++ b/module/language/cps/peel-loops.scm
@@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL)
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -149,6 +149,8 @@
($call (rename-var proc) ,(map rename-var args)))
(($ $callk k proc args)
($callk k (and proc (rename-var proc)) ,(map rename-var args)))
+ (($ $calli args callee)
+ ($calli ,(map rename-var args) (rename-var callee)))
(($ $primcall name param args)
($primcall name param ,(map rename-var args)))))
(define (rename-term term)
diff --git a/module/language/cps/reify-primitives.scm
b/module/language/cps/reify-primitives.scm
index d0441ff..3f18ca2 100644
--- a/module/language/cps/reify-primitives.scm
+++ b/module/language/cps/reify-primitives.scm
@@ -619,16 +619,14 @@
((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)))
+ (($ $kargs names vars
+ ($ $continue k src
+ (and exp (or ($ $call) ($ $callk)))))
+ ;; No need to uniquify $calli as it is always a tail call.
(with-cps cps
(let$ k (uniquify-receive k))
(setk label ($kargs names vars
- ($continue k src ($callk k* proc args))))))
+ ($continue k src ,exp)))))
(_ cps)))
(with-fresh-name-state cps
diff --git a/module/language/cps/renumber.scm b/module/language/cps/renumber.scm
index c170f5c..d5a75c1 100644
--- a/module/language/cps/renumber.scm
+++ b/module/language/cps/renumber.scm
@@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL)
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -152,8 +152,6 @@
(($ $kargs names syms ($ $continue k src ($ $code kfun)))
(maybe-visit-fun kfun labels vars))
(($ $kargs names syms ($ $continue k src ($ $callk kfun)))
- ;; Well-known functions never have a $const-fun created for them
- ;; and are only referenced by their $callk call sites.
(maybe-visit-fun kfun labels vars))
(_ (values labels vars))))
(define (visit-fun kfun labels vars)
@@ -188,6 +186,8 @@
(($ $callk k proc args)
($callk (rename-label k) (and proc (rename-var proc))
,(map rename-var args)))
+ (($ $calli args callee)
+ ($calli ,(map rename-var args) (rename-var callee)))
(($ $primcall name param args)
($primcall name param ,(map rename-var args)))))
(define (rename-arity arity)
diff --git a/module/language/cps/rotate-loops.scm
b/module/language/cps/rotate-loops.scm
index caa1da3..39fa95f 100644
--- a/module/language/cps/rotate-loops.scm
+++ b/module/language/cps/rotate-loops.scm
@@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL)
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -117,6 +117,8 @@ corresponding var from REPLACEMENTS; otherwise return VAR."
($call (rename proc) ,(rename* args)))
(($ $callk k proc args)
($callk k (and proc (rename proc)) ,(rename* args)))
+ (($ $calli args callee)
+ ($calli ,(rename* args) (rename callee)))
(($ $primcall name param args)
($primcall name param ,(rename* args))))))
(($ $branch kf kt src op param args)
diff --git a/module/language/cps/self-references.scm
b/module/language/cps/self-references.scm
index 990ce65..8e2e67a 100644
--- a/module/language/cps/self-references.scm
+++ b/module/language/cps/self-references.scm
@@ -43,6 +43,8 @@
($call (subst proc) ,(map subst args)))
(($ $callk k proc args)
($callk k (and proc (subst proc)) ,(map subst args)))
+ (($ $calli args callee)
+ ($calli ,(map subst args) (subst callee)))
(($ $primcall name param args)
($primcall name param ,(map subst args)))
(($ $values args)
diff --git a/module/language/cps/simplify.scm b/module/language/cps/simplify.scm
index ef7b86f..3fd7df5 100644
--- a/module/language/cps/simplify.scm
+++ b/module/language/cps/simplify.scm
@@ -74,6 +74,8 @@
(ref* (cons proc args)))
(($ $callk k proc args)
(ref* (if proc (cons proc args) args)))
+ (($ $calli args callee)
+ (ref* (cons callee args)))
(($ $primcall name param args)
(ref* args))
(($ $values args)
@@ -241,6 +243,8 @@
($call (subst proc) ,(map subst args)))
(($ $callk k proc args)
($callk k (and proc (subst proc)) ,(map subst args)))
+ (($ $calli args callee)
+ ($calli ,(map subst args) (subst callee)))
(($ $primcall name param args)
($primcall name param ,(map subst args)))
(($ $values args)
diff --git a/module/language/cps/slot-allocation.scm
b/module/language/cps/slot-allocation.scm
index 2537767..604d6c4 100644
--- a/module/language/cps/slot-allocation.scm
+++ b/module/language/cps/slot-allocation.scm
@@ -72,8 +72,8 @@
(call-allocs allocation-call-allocs)
;; A map of LABEL to /parallel moves/. Parallel moves shuffle locals
- ;; into position for a $call, $callk, or $values, or shuffle returned
- ;; values back into place in a $kreceive.
+ ;; into position for a $call, $callk, $calli, or $values, or shuffle
+ ;; returned values back into place in a $kreceive.
;;
;; A set of moves is expressed as an ordered list of (SRC . DST)
;; moves, where SRC and DST are slots. This may involve a temporary
@@ -231,6 +231,9 @@ is an active call."
(let ((args (list->intset args)))
(intset-subtract (if proc (intset-add args proc) args)
(intmap-ref live-out label))))
+ (($ $kargs _ _ ($ $continue _ _ ($ $calli args callee)))
+ (intset-subtract (list->intset (cons callee args))
+ (intmap-ref live-out label)))
(($ $kargs _ _ ($ $continue k _($ $values args)))
(match (intmap-ref cps k)
(($ $ktail) (list->intset args))
@@ -475,6 +478,8 @@ are comparable with eqv?. A tmp slot may be used."
(add-call-shuffles label k (cons proc args) shuffles))
(($ $callk _ proc args)
(add-call-shuffles label k (if proc (cons proc args) args) shuffles))
+ (($ $calli args callee)
+ (add-call-shuffles label k (append args (list callee)) shuffles))
(($ $values args)
(add-values-shuffles label k args shuffles))
(_ shuffles)))
@@ -518,6 +523,8 @@ are comparable with eqv?. A tmp slot may be used."
(($ $continue _ _ ($ $callk _ proc args))
(let ((nclosure (if proc 1 0)))
(call-size label (+ nclosure (length args)) size)))
+ (($ $continue _ _ ($ $calli args callee))
+ (call-size label (1+ (length args)) size))
(($ $continue _ _ ($ $values args))
(shuffle-size (get-shuffles label) size))
(_ size))))
@@ -604,6 +611,8 @@ are comparable with eqv?. A tmp slot may be used."
(allocate-call label (cons proc args) slots))
(($ $callk _ proc args)
(allocate-call label (if proc (cons proc args) args) slots))
+ (($ $calli args callee)
+ (allocate-call label (append args (list callee)) slots))
(($ $values args)
(allocate-values label k args slots))
(_ slots)))
@@ -803,6 +812,9 @@ are comparable with eqv?. A tmp slot may be used."
(($ $continue k src ($ $callk _ proc args))
(allocate-call label k (if proc (cons proc args) args)
slots call-allocs live))
+ (($ $continue k src ($ $calli args callee))
+ (allocate-call label k (append args (list callee))
+ slots call-allocs live))
(($ $continue k src ($ $values args))
(allocate-values label k args slots call-allocs))
(($ $prompt k kh src escape? tag)
diff --git a/module/language/cps/specialize-numbers.scm
b/module/language/cps/specialize-numbers.scm
index 5749624..72d893b 100644
--- a/module/language/cps/specialize-numbers.scm
+++ b/module/language/cps/specialize-numbers.scm
@@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL)
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -361,6 +361,8 @@ BITS indicating the significant bits needed for a variable.
BITS may be
(if proc
(add-unknown-use out proc)
out)))
+ (($ $calli args callee)
+ (add-unknown-uses (add-unknown-use out callee) args))
(($ $primcall name param args)
(let ((h (significant-bits-handler name)))
(if h
diff --git a/module/language/cps/split-rec.scm
b/module/language/cps/split-rec.scm
index 11b4cc6..318f396 100644
--- a/module/language/cps/split-rec.scm
+++ b/module/language/cps/split-rec.scm
@@ -94,6 +94,8 @@ references."
(if proc
(add-use proc uses)
uses)))
+ (($ $calli args callee)
+ (add-uses args (add-use callee uses)))
(($ $primcall name param args)
(add-uses args uses))))
(($ $branch kf kt src op param args)
diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index 7657bf4..bb9d673 100644
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -2031,7 +2031,7 @@ maximum, where type is a bitset as a fixnum."
(adjoin-var out def (var-type-entry in arg))))))))
(_
(propagate1 k types))))
- ((or ($ $call) ($ $callk))
+ ((or ($ $call) ($ $callk) ($ $calli))
(propagate1 k types))
(($ $rec names vars funs)
(let ((proc-type (make-type-entry &procedure -inf.0 +inf.0)))
diff --git a/module/language/cps/utils.scm b/module/language/cps/utils.scm
index 2b0c91c..73ec02b 100644
--- a/module/language/cps/utils.scm
+++ b/module/language/cps/utils.scm
@@ -351,6 +351,8 @@ by a label, respectively."
(($ $callk _ proc args)
(let ((args (vars->intset args)))
(return (get-defs k) (if proc (intset-add args proc) args))))
+ (($ $calli args callee)
+ (return (get-defs k) (intset-add (vars->intset args) callee)))
(($ $primcall name param args)
(return (get-defs k) (vars->intset args)))
(($ $values args)
diff --git a/module/language/cps/verify.scm b/module/language/cps/verify.scm
index 88dcbc0..4832e0b 100644
--- a/module/language/cps/verify.scm
+++ b/module/language/cps/verify.scm
@@ -1,5 +1,5 @@
;;; Diagnostic checker for CPS
-;;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
+;;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
;;;
;;; This library is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU Lesser General Public License as
@@ -174,6 +174,9 @@ definitions that are available at LABEL."
(when proc (check-use proc))
(for-each check-use args)
(visit-first-order kfun))
+ (($ $calli args callee)
+ (for-each check-use args)
+ (check-use callee))
(($ $primcall name param args)
(for-each check-use args)
first-order)))
@@ -211,6 +214,9 @@ definitions that are available at LABEL."
(when proc (check-use proc))
(for-each check-use args)
(visit-first-order kfun))
+ (($ $calli args callee)
+ (for-each check-use args)
+ (check-use callee))
(($ $primcall name param args)
(for-each check-use args)
first-order)))
@@ -290,10 +296,13 @@ definitions that are available at LABEL."
(match cont
(($ $ktail) #t)
(_ (assert-n-ary (length args)))))
- (($ $call proc args)
- (assert-kreceive-or-ktail))
- (($ $callk k proc args)
+ ((or ($ $call)
+ ($ $callk))
(assert-kreceive-or-ktail))
+ (($ $calli)
+ (match cont
+ (($ $ktail) #t)
+ (_ (error "expected $calli only in tail position" cont))))
(($ $primcall name param args)
(match cont
(($ $kargs) #t)