mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 04:10:18 +02:00
Code Activity

deprecate process-define-module

Browse source 
* module/ice-9/boot-9.scm:
* module/ice-9/deprecated.scm (process-define-module): Deprecate.
This commit is contained in:
Andy Wingo 2010-11-19 15:08:07 +01:00
parent cd8c35193c
commit 402c35ac81
2 changed files with 103 additions and 102 deletions
Download patch file Download diff file Expand all files Collapse all files

101
module/ice-9/boot-9.scm
View file

@ -2435,107 +2435,6 @@ If there is no handler at all, Guile prints an error and then exits."
(run-hook module-defined-hook module) (run-hook module-defined-hook module)
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 ;; `module-defined-hook' is a hook that is run whenever a new module
;; is defined. Its members are called with one argument, the new ;; is defined. Its members are called with one argument, the new
;; module. ;; module.

104
module/ice-9/deprecated.scm
View file

@ -66,7 +66,8 @@
named-module-use! named-module-use!
top-repl top-repl
turn-on-debugging turn-on-debugging
read-hash-procedures)) read-hash-procedures
process-define-module))
;;;; Deprecated definitions. ;;;; Deprecated definitions.
@ -697,3 +698,104 @@ it.")
((set! _ expr) ((set! _ expr)
(begin (read-hash-procedures-warning) (begin (read-hash-procedures-warning)
(fluid-set! %read-hash-procedures expr))))) (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)))))))