summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2010-11-19 15:08:07 +0100
committerAndy Wingo <wingo@pobox.com>2010-11-19 15:22:44 +0100
commit402c35ac8115a48ee1fe300eb87b3ed43518be94 (patch)
tree67662a068d68c58cd449623ee3a443469979fcb5
parentcd8c35193cb2e772889f799b458497bc6e6986d1 (diff)
downloadguile-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.scm101
-rw-r--r--module/ice-9/deprecated.scm104
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)))))))