78 lines
2.4 KiB
Racket
78 lines
2.4 KiB
Racket
#lang typed/racket
|
|
|
|
;;; dds/utils
|
|
|
|
;;; Various utilities.
|
|
|
|
(require (for-syntax syntax/parse)
|
|
(for-syntax racket/list))
|
|
|
|
(provide auto-hash-ref/explicit auto-hash-ref/:)
|
|
|
|
;;; HashTable Injection
|
|
|
|
;;; This section of the file contains some utilities to streamline the
|
|
;;; usage of hash tables mapping symbols to values. The goal is
|
|
;;; essentially to avoid having to write explicit hash-ref calls.
|
|
|
|
;;; Given a (HashTable Symbol a) and a sequence of symbols, binds
|
|
;;; these symbols to the values they are associated to in the hash
|
|
;;; table, then puts the body in the context of these bindings.
|
|
;;;
|
|
;;; > (let ([ht #hash((a . 1) (b . 2))])
|
|
;;; (auto-hash-ref/explicit (ht a b) (+ a (* 2 b))))
|
|
;;; 5
|
|
;;;
|
|
;;; Note that only one expression can be supplied in the body.
|
|
(define-syntax (auto-hash-ref/explicit stx)
|
|
(syntax-parse stx
|
|
[(_ (ht:id xs:id ...) body:expr)
|
|
#`(let #,(for/list ([x (syntax->list #'(xs ...))])
|
|
#`[#,x (hash-ref ht '#,x)])
|
|
body)]))
|
|
|
|
;;; Given an expression and a (HashTable Symbol a), looks up the
|
|
;;; symbols with a leading semicolon and binds them to the value they
|
|
;;; are associated to in the hash table.
|
|
;;;
|
|
;;; > (let ([ht #hash((a . 1) (b . 2))])
|
|
;;; (auto-hash-ref/: ht (+ :a (* 2 :b))))
|
|
;;; 5
|
|
;;;
|
|
;;; Note that the symbol :a is matched to the key 'a in the hash
|
|
;;; table.
|
|
;;;
|
|
;;; Note that only one expression can be supplied in the body.
|
|
(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))]))
|
|
|
|
;;; 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))))
|