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

Improve correctness and consistency of 'eval-when' usage.

* module/ice-9/boot-9.scm:
* module/ice-9/i18n.scm:
* module/ice-9/poll.scm:
* module/ice-9/popen.scm:
* module/ice-9/r6rs-libraries.scm:
* module/oop/goops.scm:
* module/oop/goops/compile.scm:
* module/oop/goops/dispatch.scm:
* module/srfi/srfi-88.scm:
* module/system/foreign.scm:
* module/texinfo/serialize.scm: Change most uses of 'compile' to
  'expand', except where we must avoid it during initial bootstrap
  before the module system is loaded.  Remove redundant uses of
  'compile' where 'expand' is also given.  Standardize on the
  "(expand load eval)" order of conditions.
This commit is contained in:
Mark H Weaver 2014-01-23 10:09:29 -05:00
parent fc1cb3fad4
commit f6ddf827f8
11 changed files with 22 additions and 22 deletions

View file

@ -1673,7 +1673,7 @@ VALUE."
(define-syntax-rule (add-to-load-path elt) (define-syntax-rule (add-to-load-path elt)
"Add ELT to Guile's load path, at compile-time and at run-time." "Add ELT to Guile's load path, at compile-time and at run-time."
(eval-when (compile load eval) (eval-when (expand load eval)
(set! %load-path (cons elt %load-path)))) (set! %load-path (cons elt %load-path))))
(define %load-verbosely #f) (define %load-verbosely #f)
@ -3087,7 +3087,7 @@ but it fails to load."
(interface options) (interface options)
(interface))) (interface)))
(define-syntax-rule (option-set! opt val) (define-syntax-rule (option-set! opt val)
(eval-when (eval load compile expand) (eval-when (expand load eval)
(options (append (options) (list 'opt val))))))))) (options (append (options) (list 'opt val)))))))))
(define-option-interface (define-option-interface
@ -3402,7 +3402,7 @@ CONV is not applied to the initial value."
;; Return a list of expressions that evaluate to the appropriate ;; Return a list of expressions that evaluate to the appropriate
;; arguments for resolve-interface according to SPEC. ;; arguments for resolve-interface according to SPEC.
(eval-when (compile) (eval-when (expand)
(if (memq 'prefix (read-options)) (if (memq 'prefix (read-options))
(error "boot-9 must be compiled with #:kw, not :kw"))) (error "boot-9 must be compiled with #:kw, not :kw")))
@ -3507,7 +3507,7 @@ CONV is not applied to the initial value."
(filename (let ((f (assq-ref (or (syntax-source x) '()) (filename (let ((f (assq-ref (or (syntax-source x) '())
'filename))) 'filename)))
(and (string? f) f)))) (and (string? f) f))))
#'(eval-when (eval load compile expand) #'(eval-when (expand load eval)
(let ((m (define-module* '(name name* ...) (let ((m (define-module* '(name name* ...)
#:filename filename quoted-arg ...))) #:filename filename quoted-arg ...)))
(set-current-module m) (set-current-module m)
@ -3567,13 +3567,13 @@ CONV is not applied to the initial value."
(syntax-case x () (syntax-case x ()
((_ spec ...) ((_ spec ...)
(with-syntax (((quoted-args ...) (quotify #'(spec ...)))) (with-syntax (((quoted-args ...) (quotify #'(spec ...))))
#'(eval-when (eval load compile expand) #'(eval-when (expand load eval)
(process-use-modules (list quoted-args ...)) (process-use-modules (list quoted-args ...))
*unspecified*)))))) *unspecified*))))))
(define-syntax-rule (use-syntax spec ...) (define-syntax-rule (use-syntax spec ...)
(begin (begin
(eval-when (eval load compile expand) (eval-when (expand load eval)
(issue-deprecation-warning (issue-deprecation-warning
"`use-syntax' is deprecated. Please contact guile-devel for more info.")) "`use-syntax' is deprecated. Please contact guile-devel for more info."))
(use-modules spec ...))) (use-modules spec ...)))
@ -3661,19 +3661,19 @@ CONV is not applied to the initial value."
names))) names)))
(define-syntax-rule (export name ...) (define-syntax-rule (export name ...)
(eval-when (eval load compile expand) (eval-when (expand load eval)
(call-with-deferred-observers (call-with-deferred-observers
(lambda () (lambda ()
(module-export! (current-module) '(name ...)))))) (module-export! (current-module) '(name ...))))))
(define-syntax-rule (re-export name ...) (define-syntax-rule (re-export name ...)
(eval-when (eval load compile expand) (eval-when (expand load eval)
(call-with-deferred-observers (call-with-deferred-observers
(lambda () (lambda ()
(module-re-export! (current-module) '(name ...)))))) (module-re-export! (current-module) '(name ...))))))
(define-syntax-rule (export! name ...) (define-syntax-rule (export! name ...)
(eval-when (eval load compile expand) (eval-when (expand load eval)
(call-with-deferred-observers (call-with-deferred-observers
(lambda () (lambda ()
(module-replace! (current-module) '(name ...)))))) (module-replace! (current-module) '(name ...))))))

View file

@ -83,7 +83,7 @@
locale-yes-regexp locale-no-regexp)) locale-yes-regexp locale-no-regexp))
(eval-when (eval load compile) (eval-when (expand load eval)
(load-extension (string-append "libguile-" (effective-version)) (load-extension (string-append "libguile-" (effective-version))
"scm_init_i18n")) "scm_init_i18n"))

View file

@ -34,7 +34,7 @@
poll-set-remove! poll-set-remove!
poll)) poll))
(eval-when (eval load compile) (eval-when (expand load eval)
(load-extension (string-append "libguile-" (effective-version)) (load-extension (string-append "libguile-" (effective-version))
"scm_init_poll")) "scm_init_poll"))

View file

@ -24,7 +24,7 @@
:export (port/pid-table open-pipe* open-pipe close-pipe open-input-pipe :export (port/pid-table open-pipe* open-pipe close-pipe open-input-pipe
open-output-pipe open-input-output-pipe)) open-output-pipe open-input-output-pipe))
(eval-when (load eval compile) (eval-when (expand load eval)
(load-extension (string-append "libguile-" (effective-version)) (load-extension (string-append "libguile-" (effective-version))
"scm_init_popen")) "scm_init_popen"))

View file

@ -217,7 +217,7 @@
(syntax-case stx () (syntax-case stx ()
((_ import-set ...) ((_ import-set ...)
(with-syntax (((library-reference ...) (map strip-for #'(import-set ...)))) (with-syntax (((library-reference ...) (map strip-for #'(import-set ...))))
#'(eval-when (eval load compile expand) #'(eval-when (expand load eval)
(let ((iface (resolve-r6rs-interface 'library-reference))) (let ((iface (resolve-r6rs-interface 'library-reference)))
(call-with-deferred-observers (call-with-deferred-observers
(lambda () (lambda ()

View file

@ -77,10 +77,10 @@
(define *goops-module* (current-module)) (define *goops-module* (current-module))
;; First initialize the builtin part of GOOPS ;; First initialize the builtin part of GOOPS
(eval-when (eval load compile) (eval-when (expand load eval)
(%init-goops-builtins)) (%init-goops-builtins))
(eval-when (eval load compile) (eval-when (expand load eval)
(use-modules ((language tree-il primitives) :select (add-interesting-primitive!))) (use-modules ((language tree-il primitives) :select (add-interesting-primitive!)))
(add-interesting-primitive! 'class-of) (add-interesting-primitive! 'class-of)
(define (@slot-ref o n) (define (@slot-ref o n)
@ -96,7 +96,7 @@
(oop goops compile)) (oop goops compile))
(eval-when (eval load compile) (eval-when (expand load eval)
(define min-fixnum (- (expt 2 29))) (define min-fixnum (- (expt 2 29)))
(define max-fixnum (- (expt 2 29) 1))) (define max-fixnum (- (expt 2 29) 1)))
@ -1123,7 +1123,7 @@
;; the idea is to compile the index into the procedure, for fastest ;; the idea is to compile the index into the procedure, for fastest
;; lookup. Also, @slot-ref and @slot-set! have their own bytecodes. ;; lookup. Also, @slot-ref and @slot-set! have their own bytecodes.
(eval-when (eval load compile) (eval-when (expand load eval)
(define num-standard-pre-cache 20)) (define num-standard-pre-cache 20))
(define-macro (define-standard-accessor-method form . body) (define-macro (define-standard-accessor-method form . body)

View file

@ -19,7 +19,7 @@
;; There are circularities here; you can't import (oop goops compile) ;; There are circularities here; you can't import (oop goops compile)
;; before (oop goops). So when compiling, make sure that things are ;; before (oop goops). So when compiling, make sure that things are
;; kosher. ;; kosher.
(eval-when (compile) (resolve-module '(oop goops))) (eval-when (expand) (resolve-module '(oop goops)))
(define-module (oop goops compile) (define-module (oop goops compile)
:use-module (oop goops) :use-module (oop goops)

View file

@ -19,7 +19,7 @@
;; There are circularities here; you can't import (oop goops compile) ;; There are circularities here; you can't import (oop goops compile)
;; before (oop goops). So when compiling, make sure that things are ;; before (oop goops). So when compiling, make sure that things are
;; kosher. ;; kosher.
(eval-when (compile) (resolve-module '(oop goops))) (eval-when (expand) (resolve-module '(oop goops)))
(define-module (oop goops dispatch) (define-module (oop goops dispatch)
#:use-module (oop goops) #:use-module (oop goops)

View file

@ -35,7 +35,7 @@
;; Change the keyword syntax both at compile time and run time; the latter is ;; Change the keyword syntax both at compile time and run time; the latter is
;; useful at the REPL. ;; useful at the REPL.
(eval-when (compile load) (eval-when (expand load eval)
(read-set! keywords 'postfix)) (read-set! keywords 'postfix))
(define (keyword->string k) (define (keyword->string k)

View file

@ -55,7 +55,7 @@
define-wrapped-pointer-type)) define-wrapped-pointer-type))
(eval-when (load eval compile) (eval-when (expand load eval)
(load-extension (string-append "libguile-" (effective-version)) (load-extension (string-append "libguile-" (effective-version))
"scm_init_foreign")) "scm_init_foreign"))

View file

@ -60,7 +60,7 @@
;; Why? Well, because syntax-case defines `include', and carps about its ;; Why? Well, because syntax-case defines `include', and carps about its
;; wrong usage below... ;; wrong usage below...
(eval-when (eval load compile) (eval-when (expand load eval)
(define (include exp lp command type formals args accum) (define (include exp lp command type formals args accum)
(list* "\n" (list* "\n"
(list-intersperse (list-intersperse