diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2021-03-27 21:38:35 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2021-03-27 21:38:35 -0700 |
| commit | 8a32d5553fea4e71ebecb48ee414723f63bb5852 (patch) | |
| tree | 3242a985cb8e96df46e22a658d4fb1cfc9e780ee /share | |
| parent | e3f221aa1db11ca3710827d91f31634dfb3b33aa (diff) | |
| download | txr-8a32d5553fea4e71ebecb48ee414723f63bb5852.tar.gz txr-8a32d5553fea4e71ebecb48ee414723f63bb5852.tar.bz2 txr-8a32d5553fea4e71ebecb48ee414723f63bb5852.zip | |
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.
Diffstat (limited to 'share')
| -rw-r--r-- | share/txr/stdlib/compiler.tl | 16 | ||||
| -rw-r--r-- | 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)))))) |