diff options
| -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 |