diff options
Diffstat (limited to 'module/language/scheme/compile-tree-il.scm')
-rw-r--r-- | module/language/scheme/compile-tree-il.scm | 35 |
1 files changed, 3 insertions, 32 deletions
diff --git a/module/language/scheme/compile-tree-il.scm b/module/language/scheme/compile-tree-il.scm index 4ac33d77e..5d01a2651 100644 --- a/module/language/scheme/compile-tree-il.scm +++ b/module/language/scheme/compile-tree-il.scm @@ -1,6 +1,6 @@ ;;; Guile Scheme specification -;; Copyright (C) 2001 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2009 Free Software Foundation, Inc. ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -24,40 +24,11 @@ ;;; 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) + (set-current-module e) (let* ((x (sc-expand x 'c '(compile load eval))) - (cenv (make-cenv (current-module) - (cenv-lexicals e) (cenv-externals e)))) + (cenv (current-module))) (values x cenv cenv))))) |