mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 20:00: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.
64 lines
2.1 KiB
Scheme
64 lines
2.1 KiB
Scheme
;;; Guile Scheme specification
|
|
|
|
;; Copyright (C) 2001 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 scheme compile-tree-il)
|
|
#:use-module (language tree-il)
|
|
#:export (compile-tree-il))
|
|
|
|
;;; environment := #f
|
|
;;; | MODULE
|
|
;;; | COMPILE-ENV
|
|
;;; compile-env := (MODULE LEXICALS . EXTERNALS)
|
|
(define (cenv-module env)
|
|
(cond ((not env) #f)
|
|
((module? env) env)
|
|
((and (pair? env) (module? (car env))) (car env))
|
|
(else (error "bad environment" env))))
|
|
|
|
(define (cenv-lexicals env)
|
|
(cond ((not env) '())
|
|
((module? env) '())
|
|
((pair? env) (cadr env))
|
|
(else (error "bad environment" env))))
|
|
|
|
(define (cenv-externals env)
|
|
(cond ((not env) '())
|
|
((module? env) '())
|
|
((pair? env) (cddr env))
|
|
(else (error "bad environment" env))))
|
|
|
|
(define (make-cenv module lexicals externals)
|
|
(cons module (cons lexicals externals)))
|
|
|
|
(define (location x)
|
|
(and (pair? x)
|
|
(let ((props (source-properties x)))
|
|
(and (not (null? props))
|
|
props))))
|
|
|
|
(define (compile-tree-il x e opts)
|
|
(save-module-excursion
|
|
(lambda ()
|
|
(and=> (cenv-module e) set-current-module)
|
|
(let* ((x (sc-expand x 'c '(compile load eval)))
|
|
(cenv (make-cenv (current-module)
|
|
(cenv-lexicals e) (cenv-externals e))))
|
|
(values x cenv cenv)))))
|