From 8a32d5553fea4e71ebecb48ee414723f63bb5852 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Sat, 27 Mar 2021 21:38:35 -0700
Subject: compiler: cache param-info objects.

* share/txr/stdlib/compiler.tl (%param-info%): New global
variable.
(compiler comp-fun-form): Use get-param-info function to get
param-info object.
(get-param-info): Retrieve object from cache, using the
function as the key. If not found, create the entry.
(compiler-emit-warning): Use get-param-info.

* share/txr/stdlib/param.tl (struct param-info): Remove symbol
slot, replacing it with the function.
(param-info :postinit): No need to do symbol-function lookup;
the function is given.
---
 share/txr/stdlib/compiler.tl | 16 +++++++++++-----
 share/txr/stdlib/param.tl    | 13 +++++--------
 2 files changed, 16 insertions(+), 13 deletions(-)

diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl
index fe796218..9cc0aa07 100644
--- a/share/txr/stdlib/compiler.tl
+++ b/share/txr/stdlib/compiler.tl
@@ -339,6 +339,8 @@
 
 (defvar *unchecked-calls*)
 
+(defvarl %param-info% (hash :eq-based :weak-keys))
+
 (defvar *load-time*)
 
 ;; 0 - no optimization
@@ -1303,8 +1305,7 @@
          (nargs (len (cdr form)))
          (fbin env.(lookup-fun sym t))
          (pars (or fbin.?pars
-                   (if (fboundp sym)
-                     (new param-info symbol sym)))))
+                   (get-param-info sym))))
     (if pars
       (param-check form nargs pars)
       (push (cons form nargs) *unchecked-calls*))
@@ -2098,6 +2099,12 @@
                              (jend ,frag.oreg))))
       (vm-make-desc co.nlev (succ as.max-treg) as.buf co.(get-datavec) co.(get-symvec)))))
 
+(defun get-param-info (sym)
+  (whenlet ((fun (symbol-function sym)))
+    (or [%param-info% fun]
+        (set [%param-info% fun]
+             (new param-info fun fun)))))
+
 (defun param-check (form nargs pars)
   (cond
     ((< nargs pars.nreq)
@@ -2118,9 +2125,8 @@
         (continue ()))))
   (each ((uc (zap *unchecked-calls*)))
     (when-match (@(as form (@sym . @args)) . @nargs) uc
-      (when (fboundp sym)
-        (let ((pars (new param-info symbol sym)))
-          (param-check form nargs pars))))))
+      (whenlet ((fun (symbol-function sym)))
+        (param-check form nargs (get-param-info sym))))))
 
 (defvarl %file-suff-rx% #/[.][^\\\/.]+/)
 
diff --git a/share/txr/stdlib/param.tl b/share/txr/stdlib/param.tl
index c04325c9..0551e9ce 100644
--- a/share/txr/stdlib/param.tl
+++ b/share/txr/stdlib/param.tl
@@ -69,16 +69,13 @@
   (defstruct (mac-param-parser syntax form) param-parser-base
     (mac-param-p t))
 
-  (defstruct (param-info symbol) nil
-    symbol
+  (defstruct (param-info fun) nil
+    fun
     nreq nopt nfix rest
     (:postinit (me)
-      (let* ((fun (or (symbol-function me.symbol)
-                      (error "~s: no such function: ~s"
-                             'param-info me.symbol)))
-             (fix (fun-fixparam-count fun))
-             (opt (fun-optparam-count fun)))
+      (let* ((fix (fun-fixparam-count me.fun))
+             (opt (fun-optparam-count me.fun)))
         (set me.nreq (- fix opt)
              me.nopt opt
              me.nfix fix
-             me.rest (fun-variadic fun))))))
+             me.rest (fun-variadic me.fun))))))
-- 
cgit v1.2.3