[honu] support for-syntax in require

This commit is contained in:
Jon Rafkind 2012-06-08 21:03:48 -06:00
parent fc96cb258c
commit 6457e69b48
5 changed files with 42 additions and 13 deletions

View File

@ -40,6 +40,7 @@
[honu-match match]
[honu-with with]
[literal:honu-where where]
[honu-for-syntax for_syntax]
[honu-var var]
[honu-val val]
[honu-for for]

View File

@ -18,8 +18,10 @@
(for-syntax syntax/parse
syntax/parse/experimental/reflect
syntax/parse/experimental/splicing
macro-debugger/emit
racket/syntax
racket/pretty
racket/string
"compile.rkt"
"util.rkt"
"debug.rkt"
@ -235,19 +237,36 @@
;; possibly handle other types of data
[else (error 'dot "don't know how to deal with ~a (~a)" 'left left*)]))))))
(provide honu-for-syntax)
(define-literal honu-for-syntax)
(begin-for-syntax
(define (fix-module-name name)
(format-id name "~a" (regexp-replace* #rx"_" (symbol->string (syntax->datum name)) "-")))
(define (combine-paths paths name)
(define all (for/list ([path (if paths
(append paths (list name))
(list name))])
(cond
[(identifier? path) (symbol->string (syntax->datum path))]
[(string? path) path]
[else (error 'combine-paths "what is ~a" path)])))
(format-id name (string-join all "/")))
(define-splicing-syntax-class require-form
#:literals (honu-prefix)
#:literals (honu-prefix honu-for-syntax)
#:literal-sets (cruft)
[pattern (~seq honu-prefix prefix module)
#:with result (with-syntax ([module (fix-module-name #'module)])
#'(prefix-in prefix module))]
[pattern (~seq honu-prefix prefix module:require-form)
#:with result #'(prefix-in prefix module.result)]
[pattern (~seq honu-for-syntax ~! (#%parens module:require-form))
#:with result #'(for-syntax module.result)]
[pattern x:str #:with result #'x]
[pattern x:id
#:with result (with-syntax ([name (fix-module-name #'x)]) #'name)
[pattern (~seq (~seq base:id (~literal honu-/)) ... x:id)
#:with result (with-syntax ([name (combine-paths
(syntax->list #'(base ...))
(fix-module-name #'x))])
(emit-remark "require-form" #'honu-for-syntax #'x)
(debug "Plain path: ~a ~a\n" #'name (free-identifier=? #'honu-for-syntax #'x))
#'name)
#:when (not ((literal-set->predicate cruft) #'x))]))
(define-for-syntax (racket-names->honu name)
@ -257,13 +276,13 @@
(define-honu-syntax honu-require
(lambda (code context)
(syntax-parse code
[(_ form:require-form ... . rest)
[(_ form1:require-form form:require-form ... . rest)
(values
(racket-syntax (require (filtered-in (lambda (name)
(regexp-replace* #rx"-"
(regexp-replace* #rx"->" name "_to_")
"_"))
(combine-in form.result ...))))
(combine-in form1.result form.result ...))))
#'rest
#f)])))

View File

@ -28,7 +28,7 @@
ellipses-comma ellipses-comma* ellipses-repeat
honu-in
honu-where
honu-for-syntax
;; honu-for-syntax
honu-for-template
honu-prefix
honu-$

View File

@ -212,6 +212,15 @@
(do-parse-rest #'(stuff ...) #'do-parse-rest-macro)]))
|#
(provide parse-local)
(define-syntax-rule (parse-local code ...)
(let ()
(define-syntax (parse-more stx)
(syntax-case stx ()
[(_ stuff (... ...))
(do-parse-rest #'(stuff (... ...)) #'parse-more)]))
(parse-more code ...)))
(provide honu-body)
(define-syntax-class honu-body
#:literal-sets (cruft)

View File

@ -398,7 +398,7 @@ See @tech{@EHpatterns} for more information.
@specsubform[(H-pattern @#,def-dotsplus . S-pattern)]{
Like an ellipses (@ellipses) pattern, but requires at one occurrence
Like an ellipses (@ellipses) pattern, but requires at least one occurrence
of the head pattern to be present.
That is, the following patterns are equivalent: