diff --git a/scribblings/utils.scrbl b/scribblings/utils.scrbl index a9b16aa..af46df0 100644 --- a/scribblings/utils.scrbl +++ b/scribblings/utils.scrbl @@ -79,6 +79,41 @@ Like @racket[eval-with], but returns only the first value computed by (eval1-with ht '(+ b a 1))) ]} +@defform[(auto-hash-ref/explicit stx) + #:contracts ([stx (VariableMapping A)])]{ + +Given a @racket[VariableMapping] and a sequence of symbols, binds these symbols +to the values they are associated with in the hash table, then puts the body in +the context of these bindings. + +@examples[#:eval utils-evaluator +(define env #hash((a . 1) (b . 2))) +(auto-hash-ref/explicit (env a b) (+ a (* 2 b))) +] + +Note that only one expression can be supplied in the body. + +} + +@defform[(auto-hash-ref/: stx) + #:contracts ([stx (VariableMapping A)])]{ + +Given an expression and a @racket[VariableMapping], looks up the symbols with +a leading semicolon and binds them to the value they are associated with in the +hash table. + +@examples[#:eval utils-evaluator +(define env #hash((a . 1) (b . 2))) +(auto-hash-ref/: env (+ :a (* 2 :b))) +] + +Thus the symbol @racket[:a] is matched to the key @racket['a] in the +hash table. + +Note that only one expression can be supplied in the body. + +} + @section{Analysis of quoted expressions} @section{Org-mode interoperability} diff --git a/utils.rkt b/utils.rkt index 0bcda42..4e1b8c7 100644 --- a/utils.rkt +++ b/utils.rkt @@ -14,7 +14,7 @@ (require typed/graph typed/rackunit (for-syntax syntax/parse racket/list)) - (provide eval-with eval1-with) + (provide eval-with eval1-with auto-hash-ref/explicit auto-hash-ref/:) (define-type Variable Symbol) (define-type (VariableMapping A) (Immutable-HashTable Variable A)) @@ -37,11 +37,73 @@ (define ht : (VariableMapping Integer) (hash 'a 1 'b 2)) (define expr : Any '(+ a b 1)) (check-equal? (eval1-with ht expr) - 4)))) + 4))) + (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)])) + + (module+ test + (test-case "auto-hash-ref/explicit" + (define mytable #hash((a . 3) (b . 4))) + (check-equal? (auto-hash-ref/explicit (mytable b a) + (* a b)) + 12) + (define ht #hash((a . #t) (b . #f))) + (check-equal? (auto-hash-ref/explicit (ht a b) + (and (not a) b)) + #f))) + + (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))])) + + (module+ test + (test-case "auto-hash-ref/:" + (define ht1 #hash((x . #t) (y . #t) (t . #f))) + (define z #t) + (check-equal? (auto-hash-ref/: ht1 + (and :x (not :y) z (or (and :t) :x))) + #f) + (define ht2 #hash((a . 1) (b . 2))) + (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))))) (require 'typed) -(provide eval-with eval1-with) +(provide eval-with eval1-with auto-hash-ref/explicit auto-hash-ref/:) ;;; Untyped section. @@ -90,109 +152,14 @@ ;; Contracts (contract-out [variable-mapping? contract?] [string-variable-mapping? contract?] - [general-pair/c (-> contract? contract? contract?)]) - ;; Syntax - auto-hash-ref/explicit auto-hash-ref/:) + [general-pair/c (-> contract? contract? contract?)])) (module+ test (require rackunit)) -;;; =================== -;;; 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. - -;;; A variable mapping is a hash table mapping symbols to values. (define (variable-mapping? dict) (hash/c symbol? any/c)) -;;; 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)])) - -(module+ test - (test-case "auto-hash-ref/explicit" - (define mytable #hash((a . 3) (b . 4))) - (check-equal? (auto-hash-ref/explicit (mytable b a) - (* a b)) - 12) - (define ht #hash((a . #t) (b . #f))) - (check-equal? (auto-hash-ref/explicit (ht a b) - (and (not a) b)) - #f))) - -;;; 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))])) - -(module+ test - (test-case "auto-hash-ref/:" - (define ht1 #hash((x . #t) (y . #t) (t . #f))) - (define z #t) - (check-equal? (auto-hash-ref/: ht1 - (and :x (not :y) z (or (and :t) :x))) - #f) - (define ht2 #hash((a . 1) (b . 2))) - (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)))) - ;;; ============================== ;;; Analysis of quoted expressions