))) #`(#:transformer '(name name* ...) . #,(parse #'args #`(#,@imp ((name name* ...))) exp rex rep aut))) ((#:use-module ((name name* ...) arg ...) . args) (and (and-map symbol? (syntax->datum #'(name name* ...)))) (parse #'args #`(#,@imp ((name name* ...) #,@(parse-iface #'(arg ...)))) exp rex rep aut)) ((#:export (ex ...) . args) (parse #'args imp #`(#,@exp ex ...) rex rep aut)) ((#:export-syntax (ex ...) . args) (parse #'args imp #`(#,@exp ex ...) rex rep aut)) ((#:re-export (re ...) . args) (parse #'args imp exp #`(#,@rex re ...) rep aut)) ((#:re-export-syntax (re ...) . args) (parse #'args imp exp #`(#,@rex re ...) rep aut)) ((#:replace (r ...) . args) (parse #'args imp exp rex #`(#,@rep r ...) aut)) ((#:replace-syntax (r ...) . args) (parse #'args imp exp rex #`(#,@rep r ...) aut)) ((#:autoload name bindings . args) (parse #'args imp exp rex rep #`(#,@aut name bindings))) ((kw val . args) (syntax-violation 'define-module "unknown keyword or bad argument" #'kw #'val)))) (syntax-case x () ((_ (name name* ...) arg ...) (and-map symbol? (syntax->datum #'(name name* ...))) (with-syntax (((quoted-arg ...) (parse #'(arg ...) '() '() '() '() '())) ;; Ideally the filename is either a string or #f; ;; this hack is to work around a case in which ;; port-filename returns a symbol (`socket') for ;; sockets. (filename (let ((f (assq-ref (or (syntax-source x) '()) 'filename))) (and (string? f) f)))) #'(eval-when (expand load eval) (let ((m (define-module* '(name name* ...) #:filename filename quoted-arg ...))) (set-current-module m) m))))))) ;; The guts of the use-modules macro. Add the interfaces of the named ;; modules to the use-list of the current module, in order. ;; This function is called by "modules.c". If you change it, be sure ;; to change scm_c_use_module as well. (define (process-use-modules module-interface-args) (let ((interfaces (map (lambda (mif-args) (or (apply resolve-interface mif-args) (error "no such module" mif-args))) module-interface-args))) (call-with-deferred-observers (lambda () (module-use-interfaces! (current-module) interfaces))))) (define-syntax use-modules (lambda (x) (define (keyword-like? stx) (let ((dat (syntax->datum stx))) (and (symbol? dat) (eqv? (string-ref (symbol->string dat) 0) #\:)))) (define (->keyword sym) (symbol->keyword (string->symbol (substring (symbol->string sym) 1)))) (define (quotify-iface args) (let loop ((in args) (out '())) (syntax-case in () (() (reverse! out)) ;; The user wanted #:foo, but wrote :foo. Fix it. ((sym . in) (keyword-like? #'sym) (loop #`(#,(->keyword (syntax->datum #'sym)) . in) out)) ((kw . in) (not (keyword? (syntax->datum #'kw))) (syntax-violation 'define-module "expected keyword arg" x #'kw)) ((#:renamer renamer . in) (loop #'in (cons* #'renamer #:renamer out))) ((kw val . in) (loop #'in (cons* #''val #'kw out)))))) (define (quotify specs) (let lp ((in specs) (out '())) (syntax-case in () (() (reverse out)) (((name name* ...) . in) (and-map symbol? (syntax->datum #'(name name* ...))) (lp #'in (cons #''((name name* ...)) out))) ((((name name* ...) arg ...) . in) (and-map symbol? (syntax->datum #'(name name* ...))) (with-syntax (((quoted-arg ...) (quotify-iface #'(arg ...)))) (lp #'in (cons #`(list '(name name* ...) quoted-arg ...) out))))))) (syntax-case x () ((_ spec ...) (with-syntax (((quoted-args ...) (quotify #'(spec ...)))) #'(eval-when (expand load eval) (process-use-modules (list quoted-args ...)) *unspecified*)))))) (include-from-path "ice-9/r6rs-libraries") (define-syntax-rule (define-private foo bar) (define foo bar)) (define-syntax define-public (syntax-rules () ((_ (name . args) . body) (begin (define (name . args) . body) (export name))) ((_ name val) (begin (define name val) (export name))))) (define-syntax-rule (defmacro-public name args body ...) (begin (defmacro name args body ...) (export-syntax name))) ;; And now for the most important macro. (define-syntax-rule (λ formals body ...) (lambda formals body ...))