mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-12 14:50:19 +02:00
a1a482e0e9
* libguile/vm-i-system.c:
* libguile/vm-engine.h (ASSERT_BOUND): New assertion, that a value is
bound. Used by local-ref and external-ref in paranoid mode.
* module/ice-9/boot-9.scm (and, or, cond, case, do): Since we are
switching to use psyntax as the first pass of the compiler, and perhaps
soon of the interpreter too, we need to make sure it expands out all
forms to primitive expressions. So define expanders for these derived
syntax forms, as in the R5RS report.
* module/ice-9/psyntax-pp.scm: Regenerate, with core forms fully
expanded.
* module/ice-9/psyntax.scm (build-void): New constructor, for making
undefined values.
(build-primref): Add in a hack so that primitive refs in the boot
module expand out to toplevel refs, not module refs.
(chi-void): Use build-void.
(if): Define an expander for if that calls build-conditional.
* module/language/scheme/compile-tree-il.scm (compile-tree-il): Use let*
so as not to depend on binding order for the result of
(current-module).
* module/language/scheme/spec.scm (scheme): Switch over to tree-il as the
primary intermediate language. Not yet fully tested, but at least it
can compile psyntax-pp.scm.
* module/language/tree-il/analyze.scm (analyze-lexicals): Arguments don't
count towards a function's nlocs.
* module/language/tree-il/compile-glil.scm (*comp-module*, compile-glil):
Define a "compilation module" fluid.
(flatten-lambda): Fix a call to make-glil-argument. Fix bug in
heapifying arguments.
(flatten): Fix number of arguments passed to apply instruction. Add a
special case for `(values ...)'. If inlining primitive-refs fails,
try expanding into toplevel-refs if the comp-module's variable is the
same as the root variable.
* module/language/tree-il/optimize.scm (resolve-primitives!): Add missing
src variable for <module-ref>.
* test-suite/tests/tree-il.test ("lambda"): Fix nlocs counts. Add a
closure test case.
89 lines
2.8 KiB
Scheme
89 lines
2.8 KiB
Scheme
;;; Tree-il optimizer
|
|
|
|
;; Copyright (C) 2009 Free Software Foundation, Inc.
|
|
|
|
;; This program is free software; you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation; either version 2, or (at your option)
|
|
;; any later version.
|
|
;;
|
|
;; This program is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
;;
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with this program; see the file COPYING. If not, write to
|
|
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
;; Boston, MA 02111-1307, USA.
|
|
|
|
;;; Code:
|
|
|
|
(define-module (language tree-il optimize)
|
|
#:use-module (system base syntax)
|
|
#:use-module (language tree-il)
|
|
#:use-module (language tree-il inline)
|
|
#:export (optimize!))
|
|
|
|
(define (env-module e)
|
|
(if e (car e) (current-module)))
|
|
|
|
(define (optimize! x env opts)
|
|
(expand-primitives! (resolve-primitives! x (env-module env))))
|
|
|
|
;; Possible optimizations:
|
|
;; * constant folding, propagation
|
|
;; * procedure inlining
|
|
;; * always when single call site
|
|
;; * always for "trivial" procs
|
|
;; * otherwise who knows
|
|
;; * dead code elimination
|
|
;; * degenerate case optimizations
|
|
;; * "fixing letrec"
|
|
|
|
(define *interesting-primitive-names*
|
|
'(apply @apply
|
|
call-with-values @call-with-values
|
|
call-with-current-continuation @call-with-current-continuation
|
|
values
|
|
;; compile-time-environment
|
|
eq? eqv? equal?
|
|
= < > <= >= zero?
|
|
+ * - / 1- 1+ quotient remainder modulo
|
|
not
|
|
pair? null? list? acons cons cons*
|
|
|
|
car cdr
|
|
set-car! set-cdr!
|
|
|
|
caar cadr cdar cddr
|
|
|
|
caaar caadr cadar caddr cdaar cdadr cddar cdddr
|
|
|
|
caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr
|
|
cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr))
|
|
|
|
(define *interesting-primitive-vars*
|
|
(let ((h (make-hash-table)))
|
|
(for-each (lambda (x)
|
|
(hashq-set! h (module-variable the-root-module x) x))
|
|
*interesting-primitive-names*)
|
|
h))
|
|
|
|
(define (resolve-primitives! x mod)
|
|
(post-order!
|
|
(lambda (x)
|
|
(record-case x
|
|
((<toplevel-ref> src name)
|
|
(and (hashq-ref *interesting-primitive-vars*
|
|
(module-variable mod name))
|
|
(make-primitive-ref src name)))
|
|
((<module-ref> src mod name public?)
|
|
;; for the moment, we're disabling primitive resolution for
|
|
;; public refs because resolve-interface can raise errors.
|
|
(let ((m (and (not public?) (resolve-module mod))))
|
|
(and m (hashq-ref *interesting-primitive-vars*
|
|
(module-variable m name))
|
|
(make-primitive-ref src name))))
|
|
(else #f)))
|
|
x))
|