[honu] clean up requires by separating code into modules

collects/honu/core/private/compile.rkt

@@ -2,87 +2,15 @@
 
 (require syntax/parse
          "debug.rkt"
-         (for-syntax racket/base "debug.rkt" syntax/parse
+         "literals.rkt"
-                     macro-debugger/emit)
+         (for-syntax racket/base
-         "literals.rkt")
+                     "debug.rkt"))
 
 ;; to get syntax as a literal
 (require (for-template racket/base))
 
 (provide (all-defined-out))
 
-(define (strip-stops code)
-  (define-syntax-class stopper #:literal-sets (cruft)
-    #;
-    [pattern semicolon]
-    [pattern honu-comma]
-    [pattern colon])
-  #;
-  (syntax-parse code
-    [(x:stopper rest ...) (strip-stops #'(rest ...))]
-    [else code])
-  code
-  )
-
-(define-syntax repeat$ (lambda (stx) (raise-syntax-error 'repeat$ "dont use this")))
-
-(define (remove-repeats input)
-  (debug 2 "Remove repeats from ~a\n" (syntax->datum input))
-  (debug 2 "Properties ~a\n" (syntax-property-symbol-keys input))
-  (define-literal-set locals (repeat$))
-  (syntax-parse input #:literal-sets ([locals #:at input])
-    [(out ... ((~literal repeat$) stuff ...) rest ...)
-     (debug 2 " Found a repeat\n")
-     (with-syntax ([(out* ...) (map remove-repeats (syntax->list #'(out ...)))]
-                   [(stuff* ...) (map remove-repeats (syntax->list #'(stuff ...)))]
-                   [(rest* ...) (map remove-repeats (syntax->list #'(rest ...)))])
-       (remove-repeats (datum->syntax input
-                                      (syntax->list #'(out* ... stuff* ... rest* ...))
-                                      input input)))]
-    [(normal ...) (with-syntax ([(normal* ...) (map remove-repeats (syntax->list #'(normal ...)))])
-                    (datum->syntax input
-                                   (syntax->list #'(normal* ...))
-                                   input input))]
-    [x #'x]
-    [else (raise-syntax-error 'repeats "unhandled case" input)]))
-
-(define-syntax (unexpand-honu-syntax stx)
-  (define (remove-repeats input)
-    (debug 2 "Remove repeats from ~a\n" (syntax->datum input))
-    (debug 2 "Properties ~a\n" (syntax-property-symbol-keys input))
-    (define-literal-set locals (repeat$))
-    (syntax-parse input #:literal-sets (locals)
-      [(out ... (repeat$ stuff ...) rest ...)
-       (debug 2 " Found a repeat\n")
-       (with-syntax ([(out* ...) (map remove-repeats (syntax->list #'(out ...)))]
-                     [(rest* ...) (map remove-repeats (syntax->list #'(rest ...)))])
-         (remove-repeats (datum->syntax input
-                                        (syntax->list #'(out* ... stuff ... rest* ...))
-                                        input input)))]
-      [(normal ...) (with-syntax ([(normal* ...) (map remove-repeats (syntax->list #'(normal ...)))])
-                      (datum->syntax input
-                                     (syntax->list #'(normal* ...))
-                                     input input))]
-      [x #'x]
-      [else (raise-syntax-error 'repeats "unhandled case" input)]))
-
-  (syntax-case stx ()
-    [(_ expr)
-     (begin
-       (debug "Expand honu syntax at phase ~a\n" (syntax-local-phase-level))
-       #;
-       (debug " Is ~a expanded ~a\n" (syntax->datum #'expr) (syntax->datum #'#'expr))
-       (emit-remark (format "Unexpand honu syntax at phase ~a" (syntax-local-phase-level))
-                    #'expr)
-       #;
-       (syntax-case #'expr ()
-         [(_ what) (debug "Properties on ~a are ~a\n" #'what (syntax-property-symbol-keys #'what))])
-       (define removed (remove-repeats #'expr))
-       (emit-local-step #'expr removed #:id #'unexpand-honu-syntax)
-       (debug "Cleansed ~a\n" (syntax->datum removed))
-       (debug "Syntax properties ~a\n" (syntax-property-symbol-keys removed))
-       removed)]))
-
 ; (define parsed-property (gensym 'honu-parsed))
 (define parsed-property 'honu-parsed)
 
@@ -103,30 +31,3 @@
      (begin
        (debug 2 "Racket syntax ~a\n" (syntax->datum #'form))
        #'(parsed-syntax #'form))]))
-
-(begin-for-syntax
-  (provide compress-dollars)
-  (define (compress-dollars stx)
-    (define-literal-set local-literals (honu-$ repeat$))
-    (define-splicing-syntax-class not-dollar
-                                  #:literal-sets (local-literals)
-      [pattern x #:when (or (not (identifier? #'x))
-                            (not (free-identifier=? #'honu-$ #'x)))
-                 #:with out #'x])
-    (debug 2 "Compress dollars ~a\n" stx)
-    (syntax-parse stx #:literal-sets (local-literals)
-      [(honu-$ x:not-dollar ... honu-$ rest ...)
-       (debug 2 "Compressing ~a\n" #'(x.out ...))
-       (with-syntax ([(rest* ...) (compress-dollars #'(rest ...))])
-         (datum->syntax stx (syntax->list #'((repeat$ x.out ...) rest* ...))
-                        stx stx))]
-      [(honu-$ rest ...)
-       (error 'compress-dollars "unmatched $ ~a" (syntax->datum stx))]
-      [(x rest ...)
-       (with-syntax ([x* (compress-dollars #'x)]
-                     [(rest* ...) (compress-dollars #'(rest ...))])
-         (datum->syntax stx
-                        (syntax->list #'(x* rest* ...))
-                        stx stx))]
-      [x #'x])))
-

collects/honu/core/private/macro2.rkt

@@ -5,6 +5,7 @@
                      syntax/stx
                      racket/set
                      racket/syntax
+                     "template.rkt"
                      "literals.rkt"
                      (prefix-in phase1: "parse2.rkt")
                      "debug.rkt"
@@ -217,11 +218,12 @@
                #'rest
                #t)])))
 
+#|
 ;; FIXME: we shouldn't need this definition here
 (define-syntax (as-honu-syntax stx)
   (syntax-parse stx
     [(_ form)
-     (define compressed (phase0:compress-dollars #'form))
+     (define compressed (compress-dollars #'form))
      (with-syntax ([stuff* (datum->syntax #'form (syntax->list compressed)
                                           #'form #'form)])
        (syntax #'stuff*))]))
@@ -234,6 +236,7 @@
        (with-syntax ([stuff* (datum->syntax #'form (syntax->list compressed)
                                             #'form #'form)])
          (syntax #'stuff*))])))
+|#
 
 (provide honu-syntax)
 ;; Do any honu-specific expansion here
@@ -243,7 +246,7 @@
       #;
       [(_ (#%parens single) . rest)
        (define context #'single)
-       (define compressed (phase0:compress-dollars #'single))
+       (define compressed (compress-dollars #'single))
        (values
          (with-syntax ([stuff* (datum->syntax context compressed context context)])
            (phase1:racket-syntax #'stuff*))
@@ -251,7 +254,7 @@
          #f)]
       [(_ (#%parens stuff ...) . rest)
        (define context (stx-car #'(stuff ...)))
-       (define compressed (phase0:compress-dollars #'(stuff ...)))
+       (define compressed (compress-dollars #'(stuff ...)))
        (values
          (with-syntax ([stuff* (datum->syntax context
                                               (syntax->list compressed)

collects/honu/core/private/parse2.rkt

@@ -8,6 +8,8 @@
          "literals.rkt"
          "debug.rkt"
          "compile.rkt"
+         "template.rkt"
+         "utils.rkt"
          racket/list
          (prefix-in transformer: "transformer.rkt")
          (prefix-in fixture: "fixture.rkt")
@@ -25,7 +27,7 @@
 ;; phase -1
 (require (for-template racket/base
                        racket/splicing
-                       "compile.rkt"
+                       ;; "compile.rkt"
                        "syntax.rkt"
                        "extra.rkt"))
 

collects/honu/core/private/template.rkt

@@ -0,0 +1,95 @@
+#lang racket/base
+
+(require syntax/parse
+         "literals.rkt"
+         "debug.rkt"
+         (for-syntax racket/base
+                     "debug.rkt"
+                     syntax/parse
+                     macro-debugger/emit
+                     ))
+
+(provide (all-defined-out))
+
+(define-syntax repeat$ (lambda (stx) (raise-syntax-error 'repeat$ "dont use this")))
+
+(define (remove-repeats input)
+  (debug 2 "Remove repeats from ~a\n" (syntax->datum input))
+  (debug 2 "Properties ~a\n" (syntax-property-symbol-keys input))
+  (define-literal-set locals (repeat$))
+  (syntax-parse input #:literal-sets ([locals #:at input])
+    [(out ... ((~literal repeat$) stuff ...) rest ...)
+     (debug 2 " Found a repeat\n")
+     (with-syntax ([(out* ...) (map remove-repeats (syntax->list #'(out ...)))]
+                   [(stuff* ...) (map remove-repeats (syntax->list #'(stuff ...)))]
+                   [(rest* ...) (map remove-repeats (syntax->list #'(rest ...)))])
+       (remove-repeats (datum->syntax input
+                                      (syntax->list #'(out* ... stuff* ... rest* ...))
+                                      input input)))]
+    [(normal ...) (with-syntax ([(normal* ...) (map remove-repeats (syntax->list #'(normal ...)))])
+                    (datum->syntax input
+                                   (syntax->list #'(normal* ...))
+                                   input input))]
+    [x #'x]
+    [else (raise-syntax-error 'repeats "unhandled case" input)]))
+
+(define-syntax (unexpand-honu-syntax stx)
+  (define (remove-repeats input)
+    (debug 2 "Remove repeats from ~a\n" (syntax->datum input))
+    (debug 2 "Properties ~a\n" (syntax-property-symbol-keys input))
+    (define-literal-set locals (repeat$))
+    (syntax-parse input #:literal-sets (locals)
+      [(out ... (repeat$ stuff ...) rest ...)
+       (debug 2 " Found a repeat\n")
+       (with-syntax ([(out* ...) (map remove-repeats (syntax->list #'(out ...)))]
+                     [(rest* ...) (map remove-repeats (syntax->list #'(rest ...)))])
+         (remove-repeats (datum->syntax input
+                                        (syntax->list #'(out* ... stuff ... rest* ...))
+                                        input input)))]
+      [(normal ...) (with-syntax ([(normal* ...) (map remove-repeats (syntax->list #'(normal ...)))])
+                      (datum->syntax input
+                                     (syntax->list #'(normal* ...))
+                                     input input))]
+      [x #'x]
+      [else (raise-syntax-error 'repeats "unhandled case" input)]))
+
+  (syntax-case stx ()
+    [(_ expr)
+     (begin
+       (debug "Expand honu syntax at phase ~a\n" (syntax-local-phase-level))
+       #;
+       (debug " Is ~a expanded ~a\n" (syntax->datum #'expr) (syntax->datum #'#'expr))
+       (emit-remark (format "Unexpand honu syntax at phase ~a" (syntax-local-phase-level))
+                    #'expr)
+       #;
+       (syntax-case #'expr ()
+         [(_ what) (debug "Properties on ~a are ~a\n" #'what (syntax-property-symbol-keys #'what))])
+       (define removed (remove-repeats #'expr))
+       (emit-local-step #'expr removed #:id #'unexpand-honu-syntax)
+       (debug "Cleansed ~a\n" (syntax->datum removed))
+       (debug "Syntax properties ~a\n" (syntax-property-symbol-keys removed))
+       removed)]))
+
+(define (compress-dollars stx)
+  (define-literal-set local-literals (honu-$ repeat$))
+  (define-splicing-syntax-class not-dollar
+                                #:literal-sets (local-literals)
+                                [pattern x #:when (or (not (identifier? #'x))
+                                                      (not (free-identifier=? #'honu-$ #'x)))
+                                         #:with out #'x])
+  (debug 2 "Compress dollars ~a\n" stx)
+  (syntax-parse stx #:literal-sets (local-literals)
+    [(honu-$ x:not-dollar ... honu-$ rest ...)
+     (debug 2 "Compressing ~a\n" #'(x.out ...))
+     (with-syntax ([(rest* ...) (compress-dollars #'(rest ...))])
+       (datum->syntax stx (syntax->list #'((repeat$ x.out ...) rest* ...))
+                      stx stx))]
+    [(honu-$ rest ...)
+     (error 'compress-dollars "unmatched $ ~a" (syntax->datum stx))]
+    [(x rest ...)
+     (with-syntax ([x* (compress-dollars #'x)]
+                   [(rest* ...) (compress-dollars #'(rest ...))])
+       (datum->syntax stx
+                      (syntax->list #'(x* rest* ...))
+                      stx stx))]
+    [x #'x]))

collects/honu/core/private/utils.rkt

@@ -0,0 +1,19 @@
+#lang racket/base
+
+(require syntax/parse
+         "literals.rkt")
+
+(provide (all-defined-out))
+
+(define (strip-stops code)
+  (define-syntax-class stopper #:literal-sets (cruft)
+    #;
+    [pattern semicolon]
+    [pattern honu-comma]
+    [pattern colon])
+  #;
+  (syntax-parse code
+    [(x:stopper rest ...) (strip-stops #'(rest ...))]
+    [else code])
+  code
+  )