tiny refactoring

sugar/cache.rkt

@@ -1,5 +1,5 @@
 #lang racket/base
-(require (for-syntax racket/base) "define.rkt")
+(require (for-syntax racket/base "private/syntax-utils.rkt") "define.rkt")
 
 
 (define+provide+safe (make-caching-proc base-proc) 
@@ -10,14 +10,6 @@
        (hash-ref! cache (list* kws kw-args args) (λ () (keyword-apply base-proc kws kw-args args)))))))
 
 
-(define-for-syntax (lambdafy stx)
-  (syntax-case stx ()
-    [(_ (id arg ... . rest-arg) body ...)
-     #'(id (λ (arg ... . rest-arg) body ...))]
-    [(_ id body-exp)
-     #'(id body-exp)]))
-
-
 (provide+safe define/caching)
 (define-syntax (define/caching stx)
   (with-syntax ([(id lambda-expr) (lambdafy stx)])

sugar/coerce.rkt

@@ -1,12 +1,4 @@
 #lang racket/base
+(require "private/syntax-utils.rkt")
 
-(define-syntax-rule (r+p modname ...)
+(require+provide/safe "coerce/base.rkt" "coerce/contract.rkt")
-  (begin
-    (begin
-      (require modname)
-      (provide (all-from-out modname))
-      (module+ safe
-        (require (submod modname safe))
-        (provide (all-from-out (submod modname safe))))) ...))
-
-(r+p "coerce/base.rkt" "coerce/contract.rkt")

sugar/define.rkt

@@ -1,5 +1,6 @@
 #lang racket/base
-(require (for-syntax racket/base racket/syntax syntax/strip-context) racket/contract)
+(require (for-syntax racket/base racket/syntax syntax/strip-context "private/syntax-utils.rkt")
+         racket/contract)
 
 
 (define-syntax (make-safe-module stx)
@@ -15,23 +16,6 @@
          (provide id))]))
 
 
-;; convert calling pattern to form (id contract body-exp)
-(define-for-syntax (lambdafy-with-contract stx)
-  (syntax-case stx ()
-    [(_ (id arg ... . rest-arg) contract body ...)
-     (replace-context #'id  #'(id contract (λ (arg ... . rest-arg) body ...)))]
-    [(_ id contract lambda-exp)
-     (replace-context #'id #'(id contract lambda-exp))]))
-
-
-;; convert calling pattern to form (id body-exp)
-(define-for-syntax (lambdafy stx)
-  (syntax-case stx ()
-    [(_ (id arg ... . rest-arg) body ...)
-     (replace-context #'id #'(id (λ (arg ... . rest-arg) body ...)))]
-    [(_ id lambda-exp)
-     (replace-context #'id #'(id lambda-exp))]))
-
 
 (define-syntax (define+provide+safe stx)
   (with-syntax ([(id contract lambda-exp) (lambdafy-with-contract stx)])

sugar/main.rkt

@@ -1,19 +1,11 @@
 #lang racket/base
+(require "private/syntax-utils.rkt")
 
-(define-syntax-rule (r+p modname ...)
+(require+provide/safe "cache.rkt"
-  (begin
+                      "coerce.rkt"
-    (begin
+                      "debug.rkt"
-      (require modname)
+                      "define.rkt"
-      (provide (all-from-out modname))
+                      "file.rkt"
-      (module+ safe
+                      "list.rkt"
-        (require (submod modname safe))
+                      "test.rkt"
-        (provide (all-from-out (submod modname safe))))) ...))
+                      "xml.rkt")
-
-(r+p "cache.rkt"
-     "coerce.rkt"
-     "debug.rkt"
-     "define.rkt"
-     "file.rkt"
-     "list.rkt"
-     "test.rkt"
-     "xml.rkt")

sugar/private/syntax-utils.rkt

@@ -0,0 +1,31 @@
+#lang racket/base
+(require (for-syntax racket/base) syntax/strip-context)
+(provide (all-defined-out))
+
+
+(define-syntax-rule (require+provide/safe modname ...)
+  (begin
+    (begin
+      (require modname)
+      (provide (all-from-out modname))
+      (module+ safe
+        (require (submod modname safe))
+        (provide (all-from-out (submod modname safe))))) ...))
+
+
+;; convert calling pattern to form (id contract body-exp)
+(define-syntax-rule (lambdafy-with-contract stx)
+  (syntax-case stx ()
+    [(_ (id arg (... ...) . rest-arg) contract body (... ...))
+     (replace-context #'id  #'(id contract (λ (arg (... ...) . rest-arg) body (... ...))))]
+    [(_ id contract lambda-exp)
+     (replace-context #'id #'(id contract lambda-exp))]))
+
+
+;; convert calling pattern to form (id body-exp)
+(define-syntax-rule (lambdafy stx)
+  (syntax-case stx ()
+    [(_ (id arg (... ...) . rest-arg) body (... ...))
+     (replace-context #'id #'(id (λ (arg (... ...) . rest-arg) body (... ...))))]
+    [(_ id lambda-exp)
+     (replace-context #'id #'(id lambda-exp))]))