diff options
| -rw-r--r-- | stdlib/compiler.tl | 35 | ||||
| -rw-r--r-- | txr.1 | 7 |
2 files changed, 40 insertions, 2 deletions
diff --git a/stdlib/compiler.tl b/stdlib/compiler.tl index 735b83d7..00dbd292 100644 --- a/stdlib/compiler.tl +++ b/stdlib/compiler.tl @@ -1423,7 +1423,12 @@ (return-from comp-fun-form me.(compile oreg env ^(progn ,*args nil)))) ((@(or identity use + * min max logior logand) @a) - (return-from comp-fun-form me.(compile oreg env a))))) + (return-from comp-fun-form me.(compile oreg env a))) + (@(require (chain . @nil) + (> olev 5) + (can-inline-chain form)) + (return-from comp-fun-form me.(compile oreg env + (inline-chain form)))))) (when (plusp olev) (tree-case form @@ -2298,6 +2303,34 @@ ,*lm-body)) lm-expr))))) +(defun inline-chain-rec (form arg) + (match-ecase form + ((chain @fun) + ^(call ,fun ,arg)) + ((chain @fun . @rest) + (inline-chain-rec ^(chain ,*rest) ^(call ,fun ,arg))))) + +(defun can-inline-chain (form) + (let (yes) + (each ((f (cdr form))) + (if-match @(or @(symbolp) + (sys:lisp1-value @(symbolp)) + (lambda . @lam)) + f + (if lam (set yes t)) + (return-from can-inline-chain nil))) + yes)) + +(defun inline-chain (form) + (match-case form + ((chain @fun) fun) + ((chain @fun . @rest) + (with-gensyms (args) + ^(lambda ,args + ,(inline-chain-rec ^(chain ,*rest) + ^(apply ,fun ,args))))) + ((chain) form))) + (defun orig-form (form) (whilet ((anc (macro-ancestor form))) (set form anc)) @@ -90939,7 +90939,12 @@ More peephole optimizations are applied. .IP 6 Additional iterations of the levels 4 and 5 optimizations are performed, if the previous iterations have coalesced some basic blocks of the program -graph. +graph. Also, at this level, +.code chain +expressions containing lambdas are inlined, eliminating the closures. +These expressions arise out of +.code opip +syntax and its derivatives. .IP 7 Certain more rarely applicable optimizations are applied which reduce code size by merging some identical code blocks, or improving some more rarely |