utils: Add eval-with and eval1-with.
This commit is contained in:
parent
18bc427454
commit
ab6e49561b
1 changed files with 30 additions and 2 deletions
32
utils.rkt
32
utils.rkt
|
@ -2,7 +2,35 @@
|
|||
|
||||
(require)
|
||||
|
||||
(provide)
|
||||
(provide Symbol VariableMapping
|
||||
eval-with eval1-with)
|
||||
|
||||
(module+ test
|
||||
(require rackunit))
|
||||
(require typed/rackunit))
|
||||
|
||||
;;; ===================
|
||||
;;; HashTable injection
|
||||
;;; ===================
|
||||
|
||||
(define-type Variable Symbol)
|
||||
(define-type (VariableMapping A) (Immutable-HashTable Variable A))
|
||||
|
||||
(: eval-with (-> (VariableMapping Any) Any AnyValues))
|
||||
(define (eval-with ht expr)
|
||||
(parameterize ([current-namespace (make-base-namespace)])
|
||||
(for ([(x val) (in-hash ht)]) (namespace-set-variable-value! x val))
|
||||
(eval expr)))
|
||||
|
||||
(: eval1-with (-> (VariableMapping Any) Any Any))
|
||||
(define (eval1-with ht expr)
|
||||
(call-with-values (λ () (eval-with ht expr))
|
||||
(λ args (car args))))
|
||||
|
||||
(module+ test
|
||||
(test-case "eval-with"
|
||||
(check-equal? (eval1-with (hash 'a 1 'b 2) '(+ a b 1))
|
||||
4)
|
||||
(define ht : (VariableMapping Integer) (hash 'a 1 'b 2))
|
||||
(define expr : Any '(+ a b 1))
|
||||
(check-equal? (eval1-with ht expr)
|
||||
4)))
|
||||
|
|
Loading…
Reference in a new issue