Streamline and simplify auto-hash-ref/:.

utils.rkt

@@ -67,15 +67,28 @@
                                             (and (not a) b))
                     #f)))
 
+  ;;; Helper functions for auto-hash-ref/:.
+  (begin-for-syntax
+    (define (colon? s)
+      (and (symbol? s)
+           (eq? (string-ref (symbol->string s) 0) #\:)))
+    (define (collect-colons datum)
+      (cond [(colon? datum) (list datum)]
+            [(list? datum)
+             (remove-duplicates (flatten (for/list ([el (in-list datum)])
+                                           (collect-colons el))))]
+            [else '()]))
+    (define (strip-colon s)
+      (string->symbol (substring (symbol->string s) 1))))
+
   (define-syntax (auto-hash-ref/: stx)
     (syntax-parse stx
-      [(_ ht:id body)
-       (let* ([names/: (collect-colons (syntax->datum #'body))])
-         #`(let #,(for/list ([x names/:])
-                    ;; put x in the same context as body
-                    #`[#,(datum->syntax #'body x)
-                       (hash-ref ht '#,(strip-colon x))])
-             body))]))
+      [(_ ht:id body:expr)
+       (define colons (collect-colons (syntax->datum stx)))
+       (define bindings (for/list ([key colons])
+                          `[,key (hash-ref ,#'ht ',(strip-colon key))]))
+       (with-syntax ([bindings-stx (datum->syntax stx bindings)])
+         #'(let bindings-stx body))]))
 
   (module+ test
     (test-case "auto-hash-ref/:"
@@ -88,30 +101,6 @@
       (check-equal? (auto-hash-ref/: ht2 (+ :a (* 2 :b)))
                     5)))
 
-  ;;; The helper functions for auto-hash-ref/:.
-  (begin-for-syntax
-    ;; Collect all the symbols starting with a colon in datum.
-    (define (collect-colons datum)
-      (remove-duplicates
-       (flatten
-        (for/list ([token datum])
-          (cond
-            [(symbol? token)
-             (let ([name (symbol->string token)])
-               (if (eq? #\: (string-ref name 0))
-                   token
-                   '()))]
-            [(list? token)
-             (collect-colons token)]
-            [else '()])))))
-
-    ;; Strip the leading colon off x.
-    (define (strip-colon x)
-      (let ([x-str (symbol->string x)])
-        (if (eq? #\: (string-ref x-str 0))
-            (string->symbol (substring x-str 1))
-            x))))
-
   (: extract-symbols (-> Any (Listof Symbol)))
   (define (extract-symbols form)
     (: extract-rec (-> Any (Listof Any)))