[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 02/03: Add new $calli expression type.
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] 02/03: Add new $calli expression type. |
|
Date: |
Thu, 22 Jun 2023 10:15:04 -0400 (EDT) |
wingo pushed a commit to branch wip-tailify
in repository guile.
commit ae3c93b2cc8b505e8283107a4cbdb3c1f8163d69
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/dump.scm | 3 +++
module/language/cps/effects-analysis.scm | 2 +-
module/language/cps/peel-loops.scm | 4 +++-
module/language/cps/reify-primitives.scm | 2 +-
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 | 18 +++++++++++++++---
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 | 14 +++++++++++++-
21 files changed, 105 insertions(+), 19 deletions(-)
diff --git a/module/language/cps.scm b/module/language/cps.scm
index f83b62533..42ebb0fe6 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 7152ca589..424a249be 100644
--- a/module/language/cps/closure-conversion.scm
+++ b/module/language/cps/closure-conversion.scm
@@ -72,6 +72,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))
@@ -205,6 +207,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)
@@ -346,6 +350,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)
@@ -786,6 +792,15 @@ bound to @var{closure}, 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 494bb5a0c..8e4e7efa3 100644
--- a/module/language/cps/compile-bytecode.scm
+++ b/module/language/cps/compile-bytecode.scm
@@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL)
-;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021, 2023 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
@@ -578,6 +578,11 @@
(compile-call #f proc args))
(($ $callk kfun proc args)
(compile-call kfun proc args))
+ (($ $calli args callee)
+ (match (intmap-ref cont k)
+ (($ $ktail)
+ (emit-moves (lookup-send-parallel-moves label allocation))
+ (compile-tail (1+ (length args)) emit-indirect-tail-call))))
(_
(match cont
(($ $kargs names vars)
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.
diff --git a/module/language/cps/cse.scm b/module/language/cps/cse.scm
index 3382b9915..bf11a6092 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)
@@ -562,6 +563,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 6c55245a5..634419ec3 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 471ca81f9..6fa38a3db 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/dump.scm b/module/language/cps/dump.scm
index 0950c2f0b..cf2174ca9 100644
--- a/module/language/cps/dump.scm
+++ b/module/language/cps/dump.scm
@@ -163,6 +163,9 @@
(arg-list
(cons (if proc (format-var proc) "_")
(map format-var args)))))
+ (($ $calli args callee)
+ (format #f "calli ~a(~a)"
+ (format-var callee) (arg-list (map format-var args))))
(($ $primcall name param args)
(format-primcall name param args))
(($ $values args)
diff --git a/module/language/cps/effects-analysis.scm
b/module/language/cps/effects-analysis.scm
index 3e81c3eb4..46a033e08 100644
--- a/module/language/cps/effects-analysis.scm
+++ b/module/language/cps/effects-analysis.scm
@@ -734,7 +734,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 c28654f62..088fee085 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 7faba6013..d970b5b48 100644
--- a/module/language/cps/reify-primitives.scm
+++ b/module/language/cps/reify-primitives.scm
@@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL)
-;; Copyright (C) 2013-2021, 2023 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021,2023 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
diff --git a/module/language/cps/renumber.scm b/module/language/cps/renumber.scm
index c170f5c82..d5a75c1c7 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 caa1da3bd..39fa95f04 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 990ce65ec..8e2e67a1b 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 ef7b86f79..3fd7df505 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 b08150f8d..8c0c8d44b 100644
--- a/module/language/cps/slot-allocation.scm
+++ b/module/language/cps/slot-allocation.scm
@@ -1,6 +1,6 @@
;; Continuation-passing style (CPS) intermediate language (IL)
-;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021,2023 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
@@ -73,8 +73,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 at a return continuation.
+ ;; into position for a $call, $callk, $calli, or $values, or shuffle
+ ;; returned values back into place for 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
@@ -237,6 +237,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))
@@ -492,6 +495,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)))
@@ -538,6 +543,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))
(($ $prompt)
@@ -624,6 +631,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)))
@@ -825,6 +834,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 574962421..72d893b80 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 11b4cc611..318f39663 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 f0579d175..095b4f7e2 100644
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -2102,7 +2102,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 d3aff7f5a..cbdc904e2 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 58317ae63..97619d63a 100644
--- a/module/language/cps/verify.scm
+++ b/module/language/cps/verify.scm
@@ -1,5 +1,5 @@
;;; Diagnostic checker for CPS
-;;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
+;;; Copyright (C) 2014-2021,2023 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,10 @@ 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)
+ first-order)
(($ $primcall name param args)
(for-each check-use args)
first-order)))
@@ -211,6 +215,10 @@ 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)
+ first-order)
(($ $primcall name param args)
(for-each check-use args)
first-order)))
@@ -294,6 +302,10 @@ definitions that are available at LABEL."
(match cont
((or ($ $kargs) ($ $kreceive) ($ $ktail)) #t)
(_ (error "expected $kargs, $kreceive or $ktail continuation" cont))))
+ (($ $calli)
+ (match cont
+ (($ $ktail) #t)
+ (_ (error "expected $calli only in tail position" cont))))
(($ $primcall name param args)
(match cont
(($ $kargs) #t)