diff options
author | Andy Wingo <wingo@pobox.com> | 2010-11-19 15:08:07 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2010-11-19 15:22:44 +0100 |
commit | 402c35ac8115a48ee1fe300eb87b3ed43518be94 (patch) | |
tree | 67662a068d68c58cd449623ee3a443469979fcb5 | |
parent | cd8c35193cb2e772889f799b458497bc6e6986d1 (diff) | |
download | guile-402c35ac8115a48ee1fe300eb87b3ed43518be94.tar.gz |
deprecate process-define-module
* module/ice-9/boot-9.scm:
* module/ice-9/deprecated.scm (process-define-module): Deprecate.
-rw-r--r-- | module/ice-9/boot-9.scm | 101 | ||||
-rw-r--r-- | module/ice-9/deprecated.scm | 104 |
2 files changed, 103 insertions, 102 deletions
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index d488aada3..6da81a77b 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -2435,107 +2435,6 @@ If there is no handler at all, Guile prints an error and then exits." (run-hook module-defined-hook module) module)) -(define (process-define-module args) - (define (missing kw) - (error "missing argument to define-module keyword" kw)) - (define (unrecognized arg) - (error "unrecognized define-module argument" arg)) - - (let ((name (car args)) - (filename #f) - (pure? #f) - (version #f) - (system? #f) - (duplicates '()) - (transformer #f)) - (let loop ((kws (cdr args)) - (imports '()) - (exports '()) - (re-exports '()) - (replacements '()) - (autoloads '())) - (if (null? kws) - (define-module* name - #:filename filename #:pure pure? #:version version - #:duplicates duplicates #:transformer transformer - #:imports (reverse! imports) - #:exports exports - #:re-exports re-exports - #:replacements replacements - #:autoloads autoloads) - (case (car kws) - ((#:use-module #:use-syntax) - (or (pair? (cdr kws)) - (missing (car kws))) - (cond - ((equal? (cadr kws) '(ice-9 syncase)) - (issue-deprecation-warning - "(ice-9 syncase) is deprecated. Support for syntax-case is now in Guile core.") - (loop (cddr kws) - imports exports re-exports replacements autoloads)) - (else - (let ((iface-spec (cadr kws))) - (if (eq? (car kws) #:use-syntax) - (set! transformer iface-spec)) - (loop (cddr kws) - (cons iface-spec imports) exports re-exports - replacements autoloads))))) - ((#:autoload) - (or (and (pair? (cdr kws)) (pair? (cddr kws))) - (missing (car kws))) - (let ((name (cadr kws)) - (bindings (caddr kws))) - (loop (cdddr kws) - imports exports re-exports - replacements (cons* name bindings autoloads)))) - ((#:no-backtrace) - ;; FIXME: deprecate? - (set! system? #t) - (loop (cdr kws) - imports exports re-exports replacements autoloads)) - ((#:pure) - (set! pure? #t) - (loop (cdr kws) - imports exports re-exports replacements autoloads)) - ((#:version) - (or (pair? (cdr kws)) - (missing (car kws))) - (set! version (cadr kws)) - (loop (cddr kws) - imports exports re-exports replacements autoloads)) - ((#:duplicates) - (if (not (pair? (cdr kws))) - (missing (car kws))) - (set! duplicates (cadr kws)) - (loop (cddr kws) - imports exports re-exports replacements autoloads)) - ((#:export #:export-syntax) - (or (pair? (cdr kws)) - (missing (car kws))) - (loop (cddr kws) - imports (append exports (cadr kws)) re-exports - replacements autoloads)) - ((#:re-export #:re-export-syntax) - (or (pair? (cdr kws)) - (missing (car kws))) - (loop (cddr kws) - imports exports (append re-exports (cadr kws)) - replacements autoloads)) - ((#:replace #:replace-syntax) - (or (pair? (cdr kws)) - (missing (car kws))) - (loop (cddr kws) - imports exports re-exports - (append replacements (cadr kws)) autoloads)) - ((#:filename) - (or (pair? (cdr kws)) - (missing (car kws))) - (set! filename (cadr kws)) - (loop (cddr kws) - imports exports re-exports replacements autoloads)) - (else - (unrecognized kws))))))) - ;; `module-defined-hook' is a hook that is run whenever a new module ;; is defined. Its members are called with one argument, the new ;; module. diff --git a/module/ice-9/deprecated.scm b/module/ice-9/deprecated.scm index 07ad6d25c..d6dd837c2 100644 --- a/module/ice-9/deprecated.scm +++ b/module/ice-9/deprecated.scm @@ -66,7 +66,8 @@ named-module-use! top-repl turn-on-debugging - read-hash-procedures)) + read-hash-procedures + process-define-module)) ;;;; Deprecated definitions. @@ -697,3 +698,104 @@ it.") ((set! _ expr) (begin (read-hash-procedures-warning) (fluid-set! %read-hash-procedures expr))))) + +(define (process-define-module args) + (define (missing kw) + (error "missing argument to define-module keyword" kw)) + (define (unrecognized arg) + (error "unrecognized define-module argument" arg)) + + (let ((name (car args)) + (filename #f) + (pure? #f) + (version #f) + (system? #f) + (duplicates '()) + (transformer #f)) + (let loop ((kws (cdr args)) + (imports '()) + (exports '()) + (re-exports '()) + (replacements '()) + (autoloads '())) + (if (null? kws) + (define-module* name + #:filename filename #:pure pure? #:version version + #:duplicates duplicates #:transformer transformer + #:imports (reverse! imports) + #:exports exports + #:re-exports re-exports + #:replacements replacements + #:autoloads autoloads) + (case (car kws) + ((#:use-module #:use-syntax) + (or (pair? (cdr kws)) + (missing (car kws))) + (cond + ((equal? (cadr kws) '(ice-9 syncase)) + (issue-deprecation-warning + "(ice-9 syncase) is deprecated. Support for syntax-case is now in Guile core.") + (loop (cddr kws) + imports exports re-exports replacements autoloads)) + (else + (let ((iface-spec (cadr kws))) + (if (eq? (car kws) #:use-syntax) + (set! transformer iface-spec)) + (loop (cddr kws) + (cons iface-spec imports) exports re-exports + replacements autoloads))))) + ((#:autoload) + (or (and (pair? (cdr kws)) (pair? (cddr kws))) + (missing (car kws))) + (let ((name (cadr kws)) + (bindings (caddr kws))) + (loop (cdddr kws) + imports exports re-exports + replacements (cons* name bindings autoloads)))) + ((#:no-backtrace) + ;; FIXME: deprecate? + (set! system? #t) + (loop (cdr kws) + imports exports re-exports replacements autoloads)) + ((#:pure) + (set! pure? #t) + (loop (cdr kws) + imports exports re-exports replacements autoloads)) + ((#:version) + (or (pair? (cdr kws)) + (missing (car kws))) + (set! version (cadr kws)) + (loop (cddr kws) + imports exports re-exports replacements autoloads)) + ((#:duplicates) + (if (not (pair? (cdr kws))) + (missing (car kws))) + (set! duplicates (cadr kws)) + (loop (cddr kws) + imports exports re-exports replacements autoloads)) + ((#:export #:export-syntax) + (or (pair? (cdr kws)) + (missing (car kws))) + (loop (cddr kws) + imports (append exports (cadr kws)) re-exports + replacements autoloads)) + ((#:re-export #:re-export-syntax) + (or (pair? (cdr kws)) + (missing (car kws))) + (loop (cddr kws) + imports exports (append re-exports (cadr kws)) + replacements autoloads)) + ((#:replace #:replace-syntax) + (or (pair? (cdr kws)) + (missing (car kws))) + (loop (cddr kws) + imports exports re-exports + (append replacements (cadr kws)) autoloads)) + ((#:filename) + (or (pair? (cdr kws)) + (missing (car kws))) + (set! filename (cadr kws)) + (loop (cddr kws) + imports exports re-exports replacements autoloads)) + (else + (unrecognized kws))))))) |