diff --git a/utils.rkt b/utils.rkt index 1679fd0..f515e22 100644 --- a/utils.rkt +++ b/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)))