1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00

make sure we compile boot code in (guile), not (guile-user)

* libguile/eval.h:
* libguile/eval.c (scm_m_eval_when): Define a cheap eval-when, used
  before syncase has booted.

* module/Makefile.am: Reorder to put (system vm) and (system repl)
  modules after the compiler, as they are not needed at runtime.

* module/ice-9/boot-9.scm: Move the eval-when earlier, to be the first
  thing -- so when we recompile Guile we do so all in the '(guile)
  module, not '(guile-user).

* module/ice-9/compile-psyntax.scm: Rewrite to assume that psyntax.scm
  will eval-when to set its module, etc. Have everything in a let --
  otherwise the `format' call is in (guile), but `target' was defined
  in (guile-user). Also, write in an eval-when to the expanded file.

* module/ice-9/psyntax-pp.scm: Regenerate.

* module/ice-9/networking.scm:
* module/ice-9/psyntax.scm:
* module/ice-9/r4rs.scm: Sprinkles of eval-when, for flavor.
This commit is contained in:
Andy Wingo 2009-04-24 23:10:31 +02:00
parent 34ad4f83ca
commit 9c35c5796c
10 changed files with 73 additions and 43 deletions

View file

@ -2140,6 +2140,25 @@ unmemoize_at_call_with_values (const SCM expr, const SCM env)
unmemoize_exprs (SCM_CDR (expr), env));
}
SCM_SYNTAX (s_eval_when, "eval-when", scm_makmmacro, scm_m_eval_when);
SCM_GLOBAL_SYMBOL (scm_sym_eval_when, s_eval_when);
SCM_SYMBOL (sym_eval, "eval");
SCM_SYMBOL (sym_load, "load");
SCM
scm_m_eval_when (SCM expr, SCM env SCM_UNUSED)
{
ASSERT_SYNTAX (scm_ilength (expr) == 3, s_bad_expression, expr);
ASSERT_SYNTAX (scm_ilength (scm_cadr (expr)) > 0, s_bad_expression, expr);
if (scm_is_true (scm_memq (sym_eval, scm_cadr (expr)))
|| scm_is_true (scm_memq (sym_load, scm_cadr (expr))))
return scm_caddr (expr);
return scm_list_1 (SCM_IM_BEGIN);
}
#if 0
/* See futures.h for a comment why futures are not enabled.

View file

@ -100,6 +100,7 @@ SCM_API SCM scm_sym_atapply;
SCM_API SCM scm_sym_atcall_cc;
SCM_API SCM scm_sym_at_call_with_values;
SCM_API SCM scm_sym_delay;
SCM_API SCM scm_sym_eval_when;
SCM_API SCM scm_sym_arrow;
SCM_API SCM scm_sym_else;
SCM_API SCM scm_sym_apply;
@ -146,6 +147,7 @@ SCM_API SCM scm_m_atslot_ref (SCM xorig, SCM env);
SCM_API SCM scm_m_atslot_set_x (SCM xorig, SCM env);
SCM_API SCM scm_m_atdispatch (SCM xorig, SCM env);
SCM_API SCM scm_m_at_call_with_values (SCM xorig, SCM env);
SCM_API SCM scm_m_eval_when (SCM xorig, SCM env);
SCM_API int scm_badargsp (SCM formals, SCM args);
SCM_API SCM scm_call_0 (SCM proc);
SCM_API SCM scm_call_1 (SCM proc, SCM arg1);

View file

@ -35,15 +35,6 @@ SOURCES = \
system/base/pmatch.scm system/base/syntax.scm \
system/base/compile.scm system/base/language.scm \
\
system/vm/debug.scm system/vm/frame.scm system/vm/instruction.scm \
system/vm/objcode.scm system/vm/profile.scm system/vm/program.scm \
system/vm/trace.scm system/vm/vm.scm \
\
system/xref.scm \
\
system/repl/repl.scm system/repl/common.scm \
system/repl/command.scm \
\
language/ghil.scm language/glil.scm language/assembly.scm \
\
$(SCHEME_LANG_SOURCES) $(ECMASCRIPT_LANG_SOURCES) \
@ -54,7 +45,7 @@ SOURCES = \
$(ICE_9_SOURCES) \
$(SRFI_SOURCES) \
$(OOP_SOURCES) \
\
$(SYSTEM_SOURCES) \
$(SCRIPTS_SOURCES)
## test.scm is not currently installed.
@ -226,6 +217,16 @@ OOP_SOURCES = \
oop/goops/accessors.scm \
oop/goops/simple.scm
SYSTEM_SOURCES = \
system/vm/debug.scm system/vm/frame.scm system/vm/instruction.scm \
system/vm/objcode.scm system/vm/profile.scm system/vm/program.scm \
system/vm/trace.scm system/vm/vm.scm \
\
system/xref.scm \
\
system/repl/repl.scm system/repl/common.scm \
system/repl/command.scm
EXTRA_DIST += oop/ChangeLog-2008
NOCOMP_SOURCES = \

View file

@ -33,6 +33,15 @@
(define (void) (if #f #f))
;; Before compiling, make sure any symbols are resolved in the (guile)
;; module, the primary location of those symbols, rather than in
;; (guile-user), the default module that we compile in.
(eval-when (compile)
(set-current-module (resolve-module '(guile))))
;;; {R4RS compliance}
;;;
@ -163,8 +172,6 @@
(define identifier? #f)
(define syntax-object->datum #f)
(define (void) (if #f #f))
(define andmap
(lambda (f first . rest)
(or (null? first)
@ -195,13 +202,6 @@
;; Before compiling, make sure any symbols are resolved in the (guile)
;; module, the primary location of those symbols, rather than in
;; (guile-user), the default module that we compile in.
(eval-when (compile)
(set-current-module (resolve-module '(guile))))
;;; {Defmacros}
;;;
;;; Depends on: features, eval-case

View file

@ -1,24 +1,18 @@
;; XXX - We need to be inside (guile) since psyntax.ss calls
;; `eval' int he `interaction-environment' aka the current module and
;; it expects to have `andmap' there. The reason for this escapes me
;; at the moment.
;;
(define-module (guile))
(define source (list-ref (command-line) 1))
(define target (list-ref (command-line) 2))
(let ((in (open-input-file source))
(out (open-output-file (string-append target ".tmp"))))
(let loop ((x (read in)))
(if (eof-object? x)
(begin
(close-port out)
(close-port in))
(begin
(write (sc-expand3 x 'c '(compile load eval))
out)
(newline out)
(loop (read in))))))
(system (format #f "mv -f ~s.tmp ~s" target target))
(let ((source (list-ref (command-line) 1))
(target (list-ref (command-line) 2)))
(let ((in (open-input-file source))
(out (open-output-file (string-append target ".tmp"))))
(write '(eval-when (compile) (set-current-module (resolve-module '(guile))))
out)
(newline out)
(let loop ((x (read in)))
(if (eof-object? x)
(begin
(close-port out)
(close-port in))
(begin
(write (sc-expand3 x 'c '(compile load eval))
out)
(newline out)
(loop (read in))))))
(system (format #f "mv -f ~s.tmp ~s" target target)))

View file

@ -17,6 +17,9 @@
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;;;;
(eval-when (compile)
(set-current-module (resolve-module '(guile))))
(define (gethostbyaddr addr) (gethost addr))
(define (gethostbyname name) (gethost name))

View file

@ -17,6 +17,9 @@
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;;;;
(eval-when (compile)
(set-current-module (resolve-module '(guile))))
(define (stat:dev f) (vector-ref f 0))
(define (stat:ino f) (vector-ref f 1))
(define (stat:mode f) (vector-ref f 2))

File diff suppressed because one or more lines are too long

View file

@ -256,6 +256,9 @@
(eval-when (compile)
(set-current-module (resolve-module '(guile))))
(let ()
(define-syntax define-structure
(lambda (x)

View file

@ -17,6 +17,9 @@
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
(eval-when (compile)
(set-current-module (resolve-module '(guile))))
;;;; apply and call-with-current-continuation