allow for pure function call removal optimization

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index f805540fcd487537c5763ecd6a4e1140c2c920d6..b6a3662ec5d88b68a22655a0def0d5c8ee244703 100644 (file)
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -1472,6 +1472,9 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non nil."
 \f
 ;;; propagate pass specific code.
 ;; A very basic propagation pass follows.
+;; This propagates values and types plus in the control flow graph.
+;; Is also responsible for removing function calls to pure functions when
+;; possible.
 
 (defsubst comp-strict-type-of (obj)
   "Given OBJ return its type understanding fixnums."
@@ -1506,29 +1509,39 @@ This can run just once."
        for insn in (comp-block-insns b)
        do (pcase insn
             (`(setimm ,lval ,_ ,v)
-             (setf (comp-mvar-const-vld lval) t)
-             (setf (comp-mvar-constant lval) v)
-             (setf (comp-mvar-type lval) (comp-strict-type-of v)))))))
+             (setf (comp-mvar-const-vld lval) t
+                   (comp-mvar-constant lval) v
+                   (comp-mvar-type lval) (comp-strict-type-of v)))))))
 
 (defsubst comp-mvar-propagate (lval rval)
   "Propagate into LVAL properties of RVAL."
-  (setf (comp-mvar-const-vld lval) (comp-mvar-const-vld rval))
-  (setf (comp-mvar-constant lval) (comp-mvar-constant rval))
-  (setf (comp-mvar-type lval) (comp-mvar-type rval)))
+  (setf (comp-mvar-const-vld lval) (comp-mvar-const-vld rval)
+        (comp-mvar-constant lval) (comp-mvar-constant rval)
+        (comp-mvar-type lval) (comp-mvar-type rval)))
+
+(defsubst comp-function-call-remove (insn f args)
+  "Given INSN when F is pure if all ARGS are known remove the function call."
+  (when (and (get f 'pure) ; Can we just optimize pure here? See byte-opt.el
+             (cl-every #'comp-mvar-const-vld args))
+    (let ((val (apply f (mapcar #'comp-mvar-constant args))))
+      (setf (car insn) 'setimm
+            (caddr insn) (comp-add-const-to-relocs val)))))
 
 (defun comp-propagate-insn (insn)
   "Propagate within INSN."
   (pcase insn
     (`(set ,lval ,rval)
      (pcase rval
-       (`(,(or 'call 'direct-call) ,f . ,_)
+       (`(,(or 'call 'direct-call) ,f . ,args)
         (setf (comp-mvar-type lval)
-              (alist-get f comp-known-ret-types)))
+              (alist-get f comp-known-ret-types))
+        (comp-function-call-remove insn f args))
        (`(,(or 'callref 'direct-callref) ,f . ,args)
         (cl-loop for v in args
                  do (setf (comp-mvar-ref v) t))
         (setf (comp-mvar-type lval)
-              (alist-get f comp-known-ret-types)))
+              (alist-get f comp-known-ret-types))
+        (comp-function-call-remove insn f args))
        (_
         (comp-mvar-propagate lval rval))))
     (`(phi ,lval . ,rest)

diff --git a/test/src/comp-test-funcs.el b/test/src/comp-test-funcs.el
index ca604b748f3af7142893943a9406c1d39a01f2cc..20d15ac0e7a49750dfa2b101593aa276f249a9fa 100644 (file)
--- a/test/src/comp-test-funcs.el
+++ b/test/src/comp-test-funcs.el
@@ -252,6 +252,11 @@
 (defun comp-tests-signal-f ()
   (signal 'foo t))
 
+(defun comp-tests-func-call-removal-f ()
+  (let ((a 10)
+       (b 3))
+    (% a b)))
+
 \f
 ;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests ;;

diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index 0a1d45724fa74d7ba07e119a1c256a24df710c5b..b008dbd574eb54638dc59ad36b84197ffd74b005 100644 (file)
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -317,6 +317,11 @@ Check that the resulting binaries do not differ."
                      (comp-tests-signal-f)
                    (t err))
                  '(foo . t))))
+
+(ert-deftest comp-tests-func-call-removal ()
+  ;; See `comp-propagate-insn' `comp-function-call-remove'.
+  (should (= (comp-tests-func-call-removal-f) 1)))
+
 \f
 ;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests ;;