3 ;; Copyright (C) 2009 Free Software Foundation, Inc.
5 ;; This program is free software; you can redistribute it and/or modify
6 ;; it under the terms of the GNU General Public License as published by
7 ;; the Free Software Foundation; either version 2, or (at your option)
10 ;; This program is distributed in the hope that it will be useful,
11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 ;; GNU General Public License for more details.
15 ;; You should have received a copy of the GNU General Public License
16 ;; along with this program; see the file COPYING. If not, write to
17 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
18 ;; Boston, MA 02111-1307, USA.
22 (define-module (language tree-il optimize)
23 #:use-module (system base syntax)
24 #:use-module (language tree-il)
25 #:use-module (language tree-il inline)
28 (define (env-module e)
29 (if e (car e) (current-module)))
31 (define (optimize! x env opts)
32 (expand-primitives! (resolve-primitives! x (env-module env))))
34 ;; Possible optimizations:
35 ;; * constant folding, propagation
36 ;; * procedure inlining
37 ;; * always when single call site
38 ;; * always for "trivial" procs
39 ;; * otherwise who knows
40 ;; * dead code elimination
41 ;; * degenerate case optimizations
44 (define *interesting-primitive-names*
46 call-with-values @call-with-values
47 call-with-current-continuation @call-with-current-continuation
49 ;; compile-time-environment
52 + * - / 1- 1+ quotient remainder modulo
54 pair? null? list? acons cons cons*
61 caaar caadr cadar caddr cdaar cdadr cddar cdddr
63 caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr
64 cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr))
66 (define *interesting-primitive-vars*
67 (let ((h (make-hash-table)))
69 (hashq-set! h (module-variable the-root-module x) x))
70 *interesting-primitive-names*)
73 (define (resolve-primitives! x mod)
77 ((<toplevel-ref> src name)
78 (and (hashq-ref *interesting-primitive-vars*
79 (module-variable mod name))
80 (make-primitive-ref src name)))
81 ((<module-ref> src mod name public?)
82 ;; for the moment, we're disabling primitive resolution for
83 ;; public refs because resolve-interface can raise errors.
84 (let ((m (and (not public?) (resolve-module mod))))
85 (and m (hashq-ref *interesting-primitive-vars*
86 (module-variable m name))
87 (make-primitive-ref src name))))