diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2021-03-04 06:41:09 -0800 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2021-03-04 06:41:09 -0800 |
| commit | 3c7cbac43de030255055acf329d075f72b837e62 (patch) | |
| tree | 36959fb10e16c571f5f802425e6048de43343ad1 /share | |
| parent | e4b8ced9469facaddae849f982eab90c290ba820 (diff) | |
| download | txr-3c7cbac43de030255055acf329d075f72b837e62.tar.gz txr-3c7cbac43de030255055acf329d075f72b837e62.tar.bz2 txr-3c7cbac43de030255055acf329d075f72b837e62.zip | |
compiler: streamline load-time hoisting of calls.
* share/txr/stdlib/compiler.tl (compiler comp-fun-form):
Rearrange the logic so that we only try the speculative
compilation when the three main conditions are right,
not before. This drastically reduces the number of times
we need to take the compiler snapshot.
Diffstat (limited to 'share')
| -rw-r--r-- | share/txr/stdlib/compiler.tl | 40 |
1 files changed, 23 insertions, 17 deletions
diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl index c74a7fb2..b5bc75ab 100644 --- a/share/txr/stdlib/compiler.tl +++ b/share/txr/stdlib/compiler.tl @@ -1266,25 +1266,31 @@ (return-from comp-fun-form me.(compile oreg env form))) (tree-bind (sym . args) form - (let* ((fbind env.(lookup-fun sym t)) - (snap me.(snapshot)) - (cfrag me.(comp-call-impl oreg env (if fbind 'call 'gcall) - (if fbind fbind.loc me.(get-sidx sym)) - args))) - (when (and (not fbind) + (let* ((fbind env.(lookup-fun sym t))) + (macrolet ((comp-fun () + 'me.(comp-call-impl oreg env (if fbind 'call 'gcall) + (if fbind fbind.loc me.(get-sidx sym)) + args))) + (if (and (not fbind) (not *load-time*) [%functional% sym]) - (let ((ok-lift-var-pov (null cfrag.fvars)) - (ok-lift-fun-pov (all cfrag.ffuns - (lambda (sym) - (and (not env.(lookup-fun sym)) - (eq (symbol-package sym) - user-package)))))) - (when (and ok-lift-var-pov ok-lift-fun-pov) - me.(restore snap) - (set cfrag me.(compile oreg env ^(sys:load-time-lit nil ,form)))))) - (pushnew sym cfrag.ffuns) - cfrag))) + (let* ((snap me.(snapshot)) + (cfrag (comp-fun)) + (ok-lift-var-pov (null cfrag.fvars)) + (ok-lift-fun-pov (all cfrag.ffuns + (lambda (sym) + (and (not env.(lookup-fun sym)) + (eq (symbol-package sym) + user-package)))))) + (cond + ((and ok-lift-var-pov ok-lift-fun-pov) + me.(restore snap) + me.(compile oreg env ^(sys:load-time-lit nil ,form))) + (t (pushnew sym cfrag.ffuns) + cfrag))) + (let ((cfrag (comp-fun))) + (pushnew sym cfrag.ffuns) + cfrag)))))) (defmeth compiler comp-apply-call (me oreg env form) (tree-bind (sym . oargs) form |