~ chicken-core (chicken-5) 050ca67f43ba3cd4e424f403564f096af3c33440
commit 050ca67f43ba3cd4e424f403564f096af3c33440
Author: Felix Winkelmann <felix@call-with-current-continuation.org>
AuthorDate: Tue Oct 9 03:49:24 2012 -0400
Commit: Peter Bex <peter.bex@xs4all.nl>
CommitDate: Mon Oct 15 20:18:02 2012 +0200
Add lightweight flow-analysis pass to remove some unnecessary type checks after normal optimization has taken place.
Even with specialization, inlining (in particular cross-module
inlining) may result in type checks that are in many cases redundant.
For example inlined record accessors compiled in safe mode, and
inlining of code in general (which is done after the normal
flow-analysis pass) will introduce type-checks that specialization
would have removed.
This patch adds a new compiler pass (called "lfa2"), that does a
simplified flow-analysis to identify redundant forms of the form
'(##core#inline "C_i_check_..." ...)'. Type-information is obtained
from constant forms and predicates like '(##core#inline
"C_i_structurep" ...)'. In unsafe mode checks will generally be
removed.
Signed-off-by: Peter Bex <peter.bex@xs4all.nl>
diff --git a/batch-driver.scm b/batch-driver.scm
index 062bb6b5..099548e2 100644
--- a/batch-driver.scm
+++ b/batch-driver.scm
@@ -91,6 +91,7 @@
(a-only (memq 'analyze-only options))
(dynamic (memq 'dynamic options))
(do-scrutinize (memq 'scrutinize options))
+ (do-lfa2 (memq 'lfa2 options))
(dumpnodes #f)
(start-time #f)
(upap #f)
@@ -437,6 +438,7 @@
(set! ##sys#explicit-library-modules
(append ##sys#explicit-library-modules uses-units))
(set! forms (cons `(declare (uses ,@uses-units)) forms)) )
+ ;; Canonicalize s-expressions
(let* ((exps0 (map canonicalize-expression
(let ((forms (append initforms forms)))
(if wrap-module
@@ -493,6 +495,7 @@
(when (memq 'check-syntax options) (exit))
+ ;; User-defined pass (s-expressions)
(let ([proc (user-pass)])
(when proc
(dribble "User pass...")
@@ -500,6 +503,7 @@
(set! exps (map proc exps))
(end-time "user pass") ) )
+ ;; Convert s-expressions to node tree
(let ((node0 (make-node
'lambda '(())
(list (build-node-graph
@@ -531,6 +535,7 @@
(dribble "Loading inline file ~a ..." ilf)
(load-inline-file ilf) )
ifs)))
+ ;; Perform scrutiny and optionally specialization
(when (or do-scrutinize enable-specialization)
;;XXX hardcoded database file name
(unless (memq 'ignore-repository options)
@@ -561,10 +566,12 @@
(set! ##sys#line-number-database #f)
(set! constant-table #f)
(set! inline-table #f)
+ ;; Analyze toplevel assignments
(unless unsafe
(scan-toplevel-assignments (first (node-subexpressions node0))) )
(begin-time)
+ ;; Convert to CPS
(let ([node1 (perform-cps-conversion node0)])
(end-time "cps conversion")
(print-node "cps" '|3| node1)
@@ -576,6 +583,7 @@
(l/d #f)
(l/d-done #f))
(begin-time)
+ ;; Analyze node tree for optimization
(let ([db (analyze 'opt node2 i progress)])
(when first-analysis
(when (memq 'u debugging-chicken)
@@ -595,6 +603,7 @@
(when (memq 's debugging-chicken)
(print-program-statistics db))
+ ;; Optimize (once)
(cond (progress
(debugging 'p "optimization pass" i)
(begin-time)
@@ -630,6 +639,12 @@
(loop (add1 i) node2 #f #f l/d-done)) ) ) )
(else
+ ;; Secondary flow-analysis
+ (when do-lfa2
+ (begin-time)
+ (debugging 'p "doing lfa2")
+ (perform-secondary-flow-analysis node2 db)
+ (end-time "secondary flow analysis"))
(print-node "optimized" '|7| node2)
;; inlining into a file with interrupts enabled would
;; change semantics
@@ -638,6 +653,7 @@
(dribble "generating global inline file `~a' ..." f)
(emit-global-inline-file f db) ) )
(begin-time)
+ ;; Closure conversion
(set! node2 (perform-closure-conversion node2 db))
(end-time "closure conversion")
(print-db "final-analysis" '|8| db i)
@@ -647,11 +663,13 @@
(print-node "closure-converted" '|9| node2)
(when a-only (exit 0))
(begin-time)
+ ;; Preparation
(receive
(node literals lliterals lambda-table)
(prepare-for-code-generation node2 db)
(end-time "preparation")
(begin-time)
+ ;; Code generation
(let ((out (if outfile (open-output-file outfile) (current-output-port))) )
(dribble "generating `~A' ..." outfile)
(generate-code literals lliterals lambda-table out filename dynamic db)
diff --git a/c-platform.scm b/c-platform.scm
index c64db6ce..04a48799 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -91,7 +91,7 @@
no-procedure-checks-for-toplevel-bindings module
no-bound-checks no-procedure-checks-for-usual-bindings no-compiler-syntax
no-parentheses-synonyms no-symbol-escape r5rs-syntax emit-all-import-libraries
- strict-types clustering
+ strict-types clustering lfa2
setup-mode no-module-registration) )
(define valid-compiler-options-with-argument
diff --git a/chicken.h b/chicken.h
index 4ee1e53f..a946d0c9 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1504,6 +1504,13 @@ extern double trunc(double);
#define C_a_i_current_milliseconds(ptr, c, dummy) C_flonum(ptr, C_milliseconds())
+#define C_i_noop1(dummy) ((dummy), C_SCHEME_UNDEFINED)
+#define C_i_noop2(dummy1, dummy2) ((dummy1), (dummy2), C_SCHEME_UNDEFINED)
+#define C_i_noop3(dummy1, dummy2, dummy3) ((dummy1), (dummy2), (dummy3), C_SCHEME_UNDEFINED)
+#define C_i_true1(dummy) ((dummy), C_SCHEME_TRUE)
+#define C_i_true2(dummy1, dummy2) ((dummy1), (dummy2), C_SCHEME_TRUE)
+#define C_i_true3(dummy1, dummy2, dummy3) ((dummy1), (dummy2), (dummy3), C_SCHEME_TRUE)
+
/* Variables: */
diff --git a/chicken.scm b/chicken.scm
index cc5e83d1..c1582102 100644
--- a/chicken.scm
+++ b/chicken.scm
@@ -28,7 +28,7 @@
(declare
(uses chicken-syntax chicken-ffi-syntax
srfi-1 srfi-4 utils files extras data-structures support
- compiler optimizer compiler-syntax scrutinizer driver platform backend
+ compiler optimizer lfa2 compiler-syntax scrutinizer driver platform backend
srfi-69))
@@ -82,12 +82,16 @@
(set! options
(cons* 'no-compiler-syntax 'no-usual-integrations options)) )
((1)
- (set! options (cons 'optimize-leaf-routines options)) )
+ (set! options
+ (cons* 'optimize-leaf-routines
+ ;XXX 'lfa2
+ options)) )
((2)
(set! options
(cons* 'optimize-leaf-routines
'inline
;XXX 'clustering
+ ;XXX 'lfa2
options)) )
((3)
(set! options
@@ -96,6 +100,7 @@
'inline-global
'local
;XXX 'clustering
+ ;XXX 'lfa2
'specialize
options) ) )
((4)
@@ -105,6 +110,7 @@
'inline-global
'specialize
;XXX 'clustering
+ ;XXX 'lfa2
'local 'unsafe
options) ) )
(else
@@ -122,6 +128,7 @@
'inline
'inline-global
'clustering
+ 'lfa2
options) ) ) ) )
(loop (cdr rest)) ) )
((eq? 'debug-level o)
diff --git a/compiler-namespace.scm b/compiler-namespace.scm
index ca873c90..69302063 100644
--- a/compiler-namespace.scm
+++ b/compiler-namespace.scm
@@ -223,6 +223,7 @@
perform-high-level-optimizations
perform-inlining!
perform-pre-optimization!
+ perform-secondary-flow-analysis
posv
posq
postponed-initforms
diff --git a/compiler.scm b/compiler.scm
index 64624bd0..c99260e8 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -1910,7 +1910,7 @@
;; decorate ##core#call node with size
(set-car! (cdddr (node-parameters n)) (- current-program-size size0)) ) ) ) ) )
- ((set! ##core#set!)
+ ((set! ##core#set!) ;XXX ##core#set! still used?
(let* ((var (first params))
(val (car subs)) )
(when (and first-analysis (not bootstrap-mode))
diff --git a/csc.scm b/csc.scm
index b067c4e1..a981233d 100644
--- a/csc.scm
+++ b/csc.scm
@@ -144,7 +144,7 @@
-no-argc-checks -no-bound-checks -no-procedure-checks -no-compiler-syntax
-emit-all-import-libraries -setup-mode -no-elevation -no-module-registration
-no-procedure-checks-for-usual-bindings -module
- -specialize -strict-types -clustering
+ -specialize -strict-types -clustering -lfa2
-no-procedure-checks-for-toplevel-bindings))
(define-constant complex-options
@@ -182,7 +182,6 @@
;;; Variables:
(define scheme-files '())
-(define generated-scheme-files '())
(define c-files '())
(define rc-files '())
(define generated-c-files '())
@@ -405,6 +404,7 @@ Usage: #{csc} FILENAME | OPTION ...
-strict-types assume variable do not change their type
-clustering combine groups of local procedures into dispatch
loop
+ -lfa2 perform additional lightweight flow-analysis pass
Configuration options:
@@ -830,8 +830,7 @@ EOF
" ") )
(set! c-files (append (list fc) c-files))
(set! generated-c-files (append (list fc) generated-c-files))))
- scheme-files)
- (unless keep-files (for-each $delete-file generated-scheme-files)) )
+ scheme-files))
;;; Compile all C/C++ and .rc files:
diff --git a/distribution/manifest b/distribution/manifest
index 9f63422f..0f31254c 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -78,6 +78,8 @@ scrutinizer.scm
irregex.scm
irregex-core.scm
irregex-utils.scm
+lfa2.c
+lfa2.scm
posixunix.scm
posixwin.scm
posix-common.scm
diff --git a/lfa2.scm b/lfa2.scm
new file mode 100644
index 00000000..97e4101d
--- /dev/null
+++ b/lfa2.scm
@@ -0,0 +1,360 @@
+;;;; lfa2.scm - a lightweight "secondary" flow analysis
+;
+; Copyright (c) 2012, The Chicken Team
+; All rights reserved.
+;
+; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following
+; conditions are met:
+;
+; Redistributions of source code must retain the above copyright notice, this list of conditions and the following
+; disclaimer.
+; Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following
+; disclaimer in the documentation and/or other materials provided with the distribution.
+; Neither the name of the author nor the names of its contributors may be used to endorse or promote
+; products derived from this software without specific prior written permission.
+;
+; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS
+; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
+; AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
+; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+; POSSIBILITY OF SUCH DAMAGE.
+
+
+;; This pass does a lightweight flow-analysis on value types, mostly
+;; to handle the case where user code performs a type-check followed
+;; by inlined accessors (for example when using record structures).
+;; Specialization takes place before inlining, so even though we have
+;; the type-information, later inlining will still keep the code for
+;; checking argument types.
+
+
+(declare
+ (unit lfa2)
+ (hide d-depth lfa2-debug d dd +type-check-map+ +predicate-map+))
+
+
+(include "compiler-namespace")
+(include "tweaks")
+
+
+(define d-depth 0)
+(define lfa2-debug #t)
+
+(define (d fstr . args)
+ (when (and scrutiny-debug (##sys#fudge 13))
+ (printf "[debug|~a] ~a~?~%" d-depth (make-string d-depth #\space) fstr args)) )
+
+(define dd d)
+
+(define-syntax d (syntax-rules () ((_ . _) (void))))
+(define-syntax dd (syntax-rules () ((_ . _) (void))))
+
+
+;;; Maps checks to types
+
+(define +type-check-map+
+ '(("C_i_check_closure" procedure)
+ ("C_i_check_exact" fixnum)
+ ("C_i_check_inexact" flonum)
+ ("C_i_check_number" fixnum flonum number)
+ ("C_i_check_string" string)
+ ("C_i_check_bytevector" blob)
+ ("C_i_check_symbol" symbol)
+ ("C_i_check_list" null pair list)
+ ("C_i_check_pair" pair)
+ ("C_i_check_locative" locative)
+ ("C_i_check_boolean" boolean)
+ ("C_i_check_vector" vector)
+ ("C_i_check_structure" *struct*) ; special case
+ ("C_i_check_char" char)
+ ("C_i_check_closure_2" procedure)
+ ("C_i_check_exact_2" fixnum)
+ ("C_i_check_inexact_2" flonum)
+ ("C_i_check_number_2" fixnum flonum number)
+ ("C_i_check_string_2" string)
+ ("C_i_check_bytevector_2" blob)
+ ("C_i_check_symbol_2" symbol)
+ ("C_i_check_list_2" null pair list)
+ ("C_i_check_pair_2" pair)
+ ("C_i_check_locative_2" locative)
+ ("C_i_check_boolean_2" boolean)
+ ("C_i_check_vector_2" vector)
+ ("C_i_check_structure_2" *struct*) ; special case
+ ("C_i_check_char_2" char)))
+
+
+;; Maps predicates to types
+
+(define +predicate-map+
+ '(("C_i_closurep" procedure)
+ ("C_fixnump" fixnum)
+ ("C_i_flonump" flonum)
+ ("C_i_numberp" number)
+ ("C_stringp" string)
+ ("C_bytevectorp" blob)
+ ("C_i_symbolp" symbol)
+ ("C_i_listp" list)
+ ("C_i_pairp" pair)
+ ("C_locativep" locative)
+ ("C_booleanp" boolean)
+ ("C_i_vectorp" vector)
+ ("C_structurep" struct)
+ ("C_i_structurep" *struct*) ; special case
+ ("C_charp" char)
+ ("C_i_portp" port)
+ ("C_i_nullp" null)))
+
+
+;; Maps constructors to types
+
+(define +constructor-map+
+ '(("C_a_i_record1" *struct*) ; special case
+ ("C_a_i_record2" *struct*)
+ ("C_a_i_record3" *struct*)
+ ("C_a_i_record4" *struct*)
+ ("C_a_i_record5" *struct*)
+ ("C_a_i_record6" *struct*)
+ ("C_a_i_record7" *struct*)
+ ("C_a_i_record8" *struct*)
+ ("C_a_i_record" *struct*)
+ ("C_a_i_string" string)
+ ("C_a_i_port" port)
+ ("C_a_i_vector1" vector)
+ ("C_a_i_vector2" vector)
+ ("C_a_i_vector3" vector)
+ ("C_a_i_vector4" vector)
+ ("C_a_i_vector5" vector)
+ ("C_a_i_vector6" vector)
+ ("C_a_i_vector7" vector)
+ ("C_a_i_vector8" vector)
+ ("C_a_pair" pair)
+ ("C_a_i_bytevector" blob)
+ ("C_a_i_make_locative" locative)
+ ("C_a_i_vector" vector)
+ ("C_a_i_list1" pair)
+ ("C_a_i_list2" pair)
+ ("C_a_i_list3" pair)
+ ("C_a_i_list4" pair)
+ ("C_a_i_list5" pair)
+ ("C_a_i_list6" pair)
+ ("C_a_i_list7" pair)
+ ("C_a_i_list8" pair)
+ ("C_a_i_cons" pair)
+ ("C_a_i_flonum" flonum)
+ ("C_a_i_fix_to_flo" flonum)
+ ;;XXX there are endless more - is it worth it?
+ ))
+
+
+;;; Walk nodes and perform simplified type-analysis
+
+(define (perform-secondary-flow-analysis node db)
+ (let ((stats '()))
+
+ (define (constant-result lit)
+ ;; a simplified variant of the one in scrutinizer.scm
+ (cond ((string? lit) 'string)
+ ((symbol? lit) 'symbol)
+ ((fixnum? lit) 'fixnum)
+ ((flonum? lit) 'float)
+ ((number? lit)
+ (case number-type
+ ((fixnum) 'fixnum)
+ ((flonum) 'flonum)
+ (else 'number)))
+ ((boolean? lit) 'boolean)
+ ((null? lit) 'null)
+ ((list? lit) 'list)
+ ((pair? lit) 'pair)
+ ((eof-object? lit) 'eof)
+ ((vector? lit) 'vector)
+ ((and (not (##sys#immediate? lit)) (##sys#generic-structure? lit))
+ `(struct ,(##sys#slot lit 0)))
+ ((char? lit) 'char)
+ (else '*)))
+
+ (define (report elim)
+ (cond ((assoc elim stats) =>
+ (lambda (a) (set-cdr! a (add1 (cdr a)))))
+ (else (set! stats (alist-cons elim 1 stats)))))
+
+ (define (assigned? var)
+ (get db var 'assigned))
+
+ (define (droppable? n)
+ (or (memq (node-class n)
+ '(quote ##core#undefined ##core#primitive ##core#lambda))
+ (and (eq? '##core#variable (node-class n))
+ (let ((var (first (node-parameters n))))
+ (or (not (get db var 'global))
+ (variable-mark var '##compiler#always-bound))))))
+
+ (define (drop! n)
+ (node-class-set! n '##core#undefined)
+ (node-parameters-set! n '())
+ (node-subexpressions-set! n '()))
+
+ (define (extinguish! node rpl) ; replace ##core#inline call
+ (report (first (node-parameters node)))
+ (let ((subs (node-subexpressions node))
+ (alldropped #t))
+ (for-each
+ (lambda (sn)
+ (if (droppable? sn)
+ (drop! sn)
+ (set! alldropped #f)))
+ subs)
+ (if alldropped
+ (drop! node)
+ (node-parameters-set!
+ node
+ (list
+ (string-append
+ rpl
+ (case (length (node-subexpressions node))
+ ((1) "1")
+ ((2) "2")
+ ((3) "3")
+ (else (bomb "bad number of arguments to extinguished ##core#inline")))))))))
+
+ (define (vartype v te ae)
+ (cond ((assq v te) => cdr)
+ (else
+ (let loop ((ae ae))
+ (cond ((null? ae) '*)
+ ((and (eq? v (cdar ae))
+ (assq (caar ae) te) )
+ => cdr)
+ (else (loop (cdr ae))))))))
+
+ (define (walk n te ae)
+ (let ((class (node-class n))
+ (params (node-parameters n))
+ (subs (node-subexpressions n)))
+ (case class
+ ((##core#variable)
+ (vartype (first params) te ae))
+ ((if ##core#cond)
+ (let ((tr (walk (first subs) te ae)))
+ (cond ((and (pair? tr) (eq? 'boolean (car tr)))
+ (walk (second subs)
+ (append (second tr) te)
+ ae)
+ (walk (third subs)
+ (append (third tr) te)
+ ae))
+ (else
+ (walk (second subs) te ae)
+ (walk (third subs) te ae)))))
+ ((quote) (constant-result (first params)))
+ ((let)
+ (let* ((val (first subs))
+ (var (first params))
+ (r (walk val te ae)))
+ (walk (second subs)
+ (if (assigned? var)
+ te
+ (alist-cons var r te))
+ (if (and (eq? '##core#variable (node-class val))
+ (not (assigned? var))
+ (not (assigned? (first (node-parameters val)))))
+ (let ((var2 (first (node-parameters val))))
+ (alist-cons var var2 (alist-cons var2 var ae)))
+ ae))))
+ ((##core#lambda ##core#direct_lambda)
+ ;; fresh env and we don't bother to create entries in the environment
+ ;; for the llist-bound variables (missing implies type '*)
+ ;;XXX (but we could treat the first arg in non-CPS lambdas as procedure...)
+ (walk (first subs) '() '())
+ 'procedure)
+ ((set! ##core#set!) ;XXX is ##core#set! still used?
+ (walk (first subs) te ae)
+ 'undefined)
+ ((##core#undefined) 'undefined)
+ ((##core#primitive) 'procedure)
+ ((##core#inline ##core#inline_allocate)
+ (for-each (cut walk <> te ae) subs)
+ (cond ((assoc (first params) +type-check-map+) =>
+ (lambda (a)
+ (let ((r1 (walk (first subs) te ae)))
+ (cond (unsafe
+ (extinguish! n "C_i_noop"))
+ ((eq? '*struct* (cadr a))
+ ;; handle known structure type
+ (when (and (pair? r1)
+ (eq? 'struct (first r1))
+ (eq? 'quote (node-class (second subs))))
+ (let ((st (first (node-parameters (second subs)))))
+ (when (and (symbol? st)
+ (eq? st (second r1)))
+ (extinguish! n "C_i_noop")))))
+ ((and (pair? r1) (eq? 'boolean (car r1)))
+ (when (memq 'boolean (cdr a))
+ (extinguish! n "C_i_noop")))
+ ;; handle other types
+ ((member r1 (cdr a))
+ (extinguish! n "C_i_noop")))
+ '*)))
+ ((assoc (first params) +predicate-map+) =>
+ (lambda (a)
+ (let ((arg (first subs)))
+ (if (eq? '##core#variable (node-class arg))
+ `(boolean
+ ((,(first (node-parameters arg))
+ .
+ ,(if (eq? '*struct* (cadr a))
+ (if (eq? 'quote (node-class (second subs)))
+ (let ((st (first
+ (node-parameters
+ (second subs)))))
+ (if (symbol? st)
+ `(struct ,st)
+ 'struct))
+ 'struct)
+ (cadr a))))
+ ())
+ (let ((r1 (walk (first subs) te ae)))
+ (cond ((eq? '*struct* (cadr a))
+ ;; known structure type
+ (when (and (pair? r1)
+ (eq? 'struct (first r1))
+ (eq? 'quote (node-class (second subs))))
+ (let ((st (first
+ (node-parameters (second subs)))))
+ (when (and (symbol? st)
+ (eq? st (second r1)))
+ (extinguish! n "C_i_true")))))
+ ((and (pair? r1) (eq? 'boolean (car r1)))
+ (when (memq 'boolean (cdr a))
+ (extinguish! n "C_i_true")))
+ ;; other types
+ ((member r1 (cdr a))
+ (extinguish! n "C_i_true")))
+ 'boolean)))))
+ ((assoc (first params) +constructor-map+) =>
+ (lambda (a)
+ (let ((arg1 (first subs)))
+ (if (and (eq? '*struct* (cadr a))
+ (eq? 'quote (node-class arg1)))
+ (let ((tag (first (node-parameters arg1))))
+ (if (symbol? tag)
+ `(struct ,tag)
+ 'struct))
+ (cadr a)))))))
+ (else
+ (for-each (cut walk <> te ae) subs)
+ '*))))
+
+ (walk node '() '())
+ (when (pair? stats)
+ (with-debugging-output
+ '(x o)
+ (lambda ()
+ (print "eliminated type checks:")
+ (for-each
+ (lambda (ss) (printf " ~a:\t~a~%" (car ss) (cdr ss)))
+ stats))))))
diff --git a/manual/Using the compiler b/manual/Using the compiler
index 568a2623..a1a0ff7e 100644
--- a/manual/Using the compiler
+++ b/manual/Using the compiler
@@ -88,6 +88,8 @@ the source text should be read from standard input.
; -local : Assume toplevel variables defined in the current compilation unit are not externally modified. This gives the compiler more opportunities for inlining. Note that this may result in counter-intuitive and non-standard behaviour: an asssignment to an exported toplevel variable executed in a different compilation unit or in evaluated code will possibly not be seen by code executing in the current compilation unit.
+; -lfa2 : Does an additional lightweight flow-analysis pass on the fully optimized program to remove more type checks.
+
; -module : wraps the compiled code in an implicit module named {{main}}, importing the {{scheme}} and {{chicken}} modules.
; -no-argc-checks : disable argument count checks
@@ -126,7 +128,7 @@ the source text should be read from standard input.
-optimize-level 2 is equivalent to -optimize-leaf-routines -inline
-optimize-level 3 is equivalent to -optimize-leaf-routines -local -inline -inline-global -specialize
-optimize-level 4 is equivalent to -optimize-leaf-routines -local -inline -inline-global -specialize -unsafe
- -optimize-level 5 is equivalent to -optimize-leaf-routines -block -inline -inline-global -specialize -unsafe -disable-interrupts -no-trace -no-lambda-info
+ -optimize-level 5 is equivalent to -optimize-leaf-routines -block -inline -inline-global -specialize -unsafe -disable-interrupts -no-trace -no-lambda-info -clustering -lfa2
; -output-file FILENAME : Specifies the pathname of the generated C file. Default is {{FILENAME.c}}.
diff --git a/rules.make b/rules.make
index 29bc2bf5..c467b88f 100644
--- a/rules.make
+++ b/rules.make
@@ -44,7 +44,7 @@ LIBCHICKEN_SHARED_OBJECTS = $(LIBCHICKEN_OBJECTS_1:=$(O))
LIBCHICKEN_STATIC_OBJECTS = $(LIBCHICKEN_OBJECTS_1:=-static$(O))
COMPILER_OBJECTS_1 = \
- chicken batch-driver compiler optimizer compiler-syntax scrutinizer support \
+ chicken batch-driver compiler optimizer lfa2 compiler-syntax scrutinizer support \
c-platform c-backend
COMPILER_OBJECTS = $(COMPILER_OBJECTS_1:=$(O))
COMPILER_STATIC_OBJECTS = $(COMPILER_OBJECTS_1:=-static$(O))
diff --git a/support.scm b/support.scm
index 7fab02bd..9c4cedc1 100644
--- a/support.scm
+++ b/support.scm
@@ -1705,6 +1705,7 @@ Usage: chicken FILENAME OPTION ...
-strict-types assume variable do not change their type
-clustering combine groups of local procedures into dispatch
loop
+ -lfa2 perform additional lightweight flow-analysis pass
Configuration options:
Trap