diff --git a/utils-tests.rkt b/utils-tests.rkt index 23d3046..c9521ec 100644 --- a/utils-tests.rkt +++ b/utils-tests.rkt @@ -23,4 +23,9 @@ #f)) (let ([ht #hash((a . 1) (b . 2))]) (check-equal? (auto-hash-ref/: ht (+ :a (* 2 :b))) - 5)))) + 5))) + + (test-case "eval-with" + (check-equal? (let ([ht #hash((a . 1) (b . 1))]) + (eval-with1 ht '(+ b a 1))) + 3))) diff --git a/utils.rkt b/utils.rkt index d91838d..c9391bf 100644 --- a/utils.rkt +++ b/utils.rkt @@ -7,7 +7,7 @@ (require (for-syntax syntax/parse) (for-syntax racket/list)) -(provide auto-hash-ref/explicit auto-hash-ref/:) +(provide auto-hash-ref/explicit auto-hash-ref/: eval-with eval-with1) ;;; HashTable Injection @@ -76,3 +76,37 @@ (if (eq? #\: (string-ref x-str 0)) (string->symbol (substring x-str 1)) x)))) + +;;; Temporarily injects the mappings from the given hash table as +;;; bindings in the current namespace and then evaluates the +;;; expression. +;;; +;;; > (let ([ht #hash((a . 1) (b . 1))]) +;;; (eval-with ht '(+ b a 1))) +;;; 3 +;;; +;;; The local bindings from the current lexical scope are not +;;; conserved. Therefore, the following outputs an error about a +;;; missing identifier: +;;; +;;; > (let ([ht #hash((a . 1) (b . 1))] +;;; [z 1]) +;;; (eval-with ht '(+ b z a 1))) +;;; +(: eval-with (-> (HashTable Symbol Any) Any AnyValues)) +(define (eval-with ht expr) + (parameterize ([current-namespace (current-namespace)]) + (hash-for-each ht (lambda (x val) + (namespace-set-variable-value! x val))) + (eval expr))) + +;;; Same as eval-with, but returns only the first value produced by +;;; the evaluated expression. +(: eval-with1 (-> (HashTable Symbol Any) Any Any)) +(define (eval-with1 ht expr) + (let ([vals (call-with-values (λ () (eval-with ht expr)) + (λ vals vals))]) + (car vals))) + +(let ([ht #hash((a . 1) (b . 1))]) + (eval-with1 ht '(+ b a 1)))