(module require mzscheme
(provide define-module
define-library
hygienic:define-module
hygienic:define-library)
(define-for-syntax (join . args)
(define (to-string x)
(cond [(string? x) x]
[(symbol? x) (symbol->string x)]
[(identifier? x) (symbol->string (syntax-e x))]))
(string->symbol (apply string-append (map to-string args))))
(define-syntax (define-module stx)
(syntax-case stx ()
[(_ name mod-spec ...)
(with-syntax ([name
(datum->syntax-object #'name (join 'require- #'name))]
[name4stx
(datum->syntax-object #'name (join 'require-for-syntax- #'name))]
[name4templ
(datum->syntax-object #'name (join 'require-for-template- #'name))])
#'(hygienic:define-module name name4stx name4templ mod-spec ...))]))
(define-syntax (hygienic:define-module stx)
(syntax-case stx ()
[(_ name name4stx name4templ mod-spec ...)
#'(begin
(define-require-form name require mod-spec ...)
(define-require-form name4stx require-for-syntax mod-spec ...)
(define-require-form name4templ require-for-template mod-spec ...))]))
(define-syntax (define-require-form stx)
(syntax-case stx ()
[(_ name require-form mod-spec ...)
#`(begin
(define-syntax (name x)
(syntax-case x ()
[(name)
(datum->syntax-object x `(,#'require-form mod-spec ...))]))
#,(if (eq? (syntax-local-context) 'module)
#'(provide name)
#'(begin)))]))
(define-syntax (define-library stx)
(syntax-case stx ()
[(_ name pkg-spec)
(with-syntax ([name
(datum->syntax-object #'name (join 'require- #'name))]
[name4stx
(datum->syntax-object #'name (join 'require-for-syntax- #'name))]
[name4templ
(datum->syntax-object #'name (join 'require-for-template #'name))])
#'(hygienic:define-library name name4stx name4templ pkg-spec))]))
(define-syntax (hygienic:define-library stx)
(syntax-case stx ()
[(_ name name4stx name4templ abs-mod-spec)
#'(begin (define-require-abstraction name require abs-mod-spec)
(define-require-abstraction name4stx require-for-syntax abs-mod-spec)
(define-require-abstraction name4templ require-for-template abs-mod-spec))]))
(define-syntax (define-require-abstraction stx)
(syntax-case stx ()
[(_ name require-form abs-mod-spec)
#`(begin
#,(if (eq? (syntax-local-context 'module))
#'(provide name)
#'(begin))
#,(syntax-case #'abs-mod-spec (lib planet file)
[(lib dir0 subdir ...)
(eq? 'lib (syntax-e #'lib))
#`(define-syntax (name x)
(syntax-case x ()
[(name module-file . morepaths)
(datum->syntax-object
x
`(#,#'require-form
(lib ,#'module-file dir0 subdir ... . ,#'morepaths)))]))]
[(planet pkg subdir ...)
(eq? 'planet (syntax-e #'planet))
#`(define-syntax (name x)
(syntax-case x ()
[(name module-file . morepaths)
(datum->syntax-object
x
`(#,#'require-form
(planet ,#'module-file pkg subdir ... . ,#'morepaths)))]))]
[(file abspath)
(eq? 'file (syntax-e #'file))
#'(define-syntax (name x)
(syntax-case x ()
[(name module-file . morepaths)
(datum->syntax-object
x
`(#,#'require-form
(file ,(path->string
(build-path (apply build-path abspath
(map syntax-e (syntax->list #'morepaths)))
(syntax-e #'module-file))))))]))]))]))
)