diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2018-05-23 19:06:04 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2018-05-23 19:06:04 -0700 |
| commit | b83139942db2b8f5b45b2e6ce7b03f50899e894a (patch) | |
| tree | 9278d9b41305f72729fb7dc15904029451a3c051 /share | |
| parent | 749b925f3a4f85178cd7db737aa194e2de15c493 (diff) | |
| download | txr-b83139942db2b8f5b45b2e6ce7b03f50899e894a.tar.gz txr-b83139942db2b8f5b45b2e6ce7b03f50899e894a.tar.bz2 txr-b83139942db2b8f5b45b2e6ce7b03f50899e894a.zip | |
compiler: elide unused lexical functions.
This makes certain macros cheaper: macros which wrap code
with numerous local functions, not all of which are expected
to be used.
* share/txr/stdlib/compiler.tl (compiler comp-fbind): Detect
functions that are completely unused, and eliminate their
code.
Diffstat (limited to 'share')
| -rw-r--r-- | share/txr/stdlib/compiler.tl | 24 |
1 files changed, 16 insertions, 8 deletions
diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl index e1303d89..5095811e 100644 --- a/share/txr/stdlib/compiler.tl +++ b/share/txr/stdlib/compiler.tl @@ -765,22 +765,30 @@ (each ((lfun lexfuns)) nenv.(extend-fun lfun)) (let* (ffuns fvars - (code (build - (add ^(frame ,nenv.lev ,frsize)) - (each ((fi fis)) + (ffrags (collect-each ((fi fis)) (tree-bind (sym : form) fi (let* ((bind nenv.(lookup-fun sym)) (frag me.(compile bind.loc (if rec nenv eenv) form))) - (pend frag.code - (maybe-mov bind.loc frag.oreg)) - (set ffuns (uni ffuns frag.ffuns) - fvars (uni fvars frag.fvars))))))) + (list bind + (new (frag frag.oreg + (append frag.code + (maybe-mov bind.loc frag.oreg)) + frag.fvars + frag.ffuns))))))) (bfrag me.(comp-progn oreg nenv body)) (boreg (if env.(out-of-scope bfrag.oreg) oreg bfrag.oreg))) + (set ffrags (append-each ((bf ffrags)) + (tree-bind (bind ff) bf + (when bind.used + (set ffuns (uni ffuns ff.ffuns) + fvars (uni fvars ff.fvars)) + (list ff))))) (new (frag boreg - (append code bfrag.code + (append ^((frame ,nenv.lev ,frsize)) + (mappend .code ffrags) + bfrag.code (maybe-mov boreg bfrag.oreg) ^((end ,boreg))) (uni fvars bfrag.fvars) |