[honu] support for-syntax in require

collects/honu/core/main.rkt

@@ -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]

collects/honu/core/private/honu2.rkt

@@ -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)
+    [pattern (~seq honu-prefix prefix module:require-form)
-             #:with result (with-syntax ([module (fix-module-name #'module)])
+             #:with result #'(prefix-in prefix module.result)]
-                             #'(prefix-in prefix module))]
+    [pattern (~seq honu-for-syntax ~! (#%parens module:require-form))
+             #:with result #'(for-syntax module.result)]
     [pattern x:str #:with result #'x]
-    [pattern x:id
+    [pattern (~seq (~seq base:id (~literal honu-/)) ... x:id)
-             #:with result (with-syntax ([name (fix-module-name #'x)]) #'name)
+             #: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"-"
-                                                    (regexp-replace* #rx"->" name "_to_")
+                                                                 (regexp-replace* #rx"->" name "_to_")
-                                                    "_"))
+                                                                 "_"))
-                                 (combine-in form.result ...))))
+                                              (combine-in form1.result form.result ...))))
 
          #'rest
          #f)])))

collects/honu/core/private/literals.rkt

@@ -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-$

collects/honu/core/private/parse2.rkt

@@ -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)

collects/syntax/scribblings/parse/patterns.scrbl

@@ -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: