diff options
Diffstat (limited to 'stdlib')
| -rw-r--r-- | stdlib/comp-opts.tl | 9 | ||||
| -rw-r--r-- | stdlib/compiler.tl | 14 |
2 files changed, 13 insertions, 10 deletions
diff --git a/stdlib/comp-opts.tl b/stdlib/comp-opts.tl index bc0e7c59..c964f341 100644 --- a/stdlib/comp-opts.tl +++ b/stdlib/comp-opts.tl @@ -31,12 +31,11 @@ usr:shadow-cross usr:unused usr:constant-throws - usr:log-level) + usr:log-level + usr:opt-tail-calls) -(defsymacro %warning-syms% '(shadow-fun shadow-var shadow-cross - unused log-level constant-throws)) - -(defvar usr:*compile-opts* (new compile-opts unused t constant-throws t)) +(defvar usr:*compile-opts* (new compile-opts unused t constant-throws t + opt-tail-calls :)) (defmacro when-opt (compile-opt . forms) (with-gensyms (optval) diff --git a/stdlib/compiler.tl b/stdlib/compiler.tl index 37c5df56..6a49551a 100644 --- a/stdlib/compiler.tl +++ b/stdlib/compiler.tl @@ -342,7 +342,7 @@ ;; 0 - no optimization ;; 1 - constant folding, algebraics. -;; 2 - block elimination, frame elimination +;; 2 - block elimination, frame elimination, self tail calls ;; 3 - lambda/combinator lifting ;; 4 - control-flow: jump-threading, dead code ;; 5 - data-flow: dead registers, useless regisers @@ -1127,6 +1127,7 @@ (*top-level* nil) (tfn *tail-fun*) (tpos nil) + (tco *compile-opts*.opt-tail-calls) (pars (new (fun-param-parser par-syntax form))) (need-frame (or (plusp pars.nfix) pars.rest)) (nenv (if need-frame (new env up env co me) env)) @@ -1134,7 +1135,10 @@ (when (> pars.nfix %max-lambda-fixed-args%) (compile-warning form "~s arguments in a lambda (max is ~s)" pars.nfix %max-lambda-fixed-args%)) - (when (and tfn (eq tfn.lambda form)) + (when (and (caseq tco + (: (>= *opt-level* 2)) + ((t) t)) + tfn (eq tfn.lambda form)) (set tfn.env nenv tfn.label (gensym "l") tpos t)) @@ -2846,11 +2850,11 @@ (defmacro usr:with-compile-opts (:form form . clauses) (match-case clauses (() ()) - (((@(as op @(or nil t :warn :error @(integerp))) . @syms) . @rest) + (((@(as op @(or nil t :warn :error : @(integerp))) . @syms) . @rest) (each ((s syms)) - (unless (member s %warning-syms%) + (unless (member s (load-time (slots 'compile-opts))) (compile-error form - "~s isn't a recognized warning option" s))) + "~s isn't a recognized compile option" s))) ^(compiler-let ((*compile-opts* (let ((co (copy *compile-opts*))) (set ,*(mappend (ret ^(co.,@1 ,op)) syms)) |