guile-commits
[Top][All Lists]
Advanced

[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)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]