From ab6e49561b778f5e1f173bfff9b346f35b36e779 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Mon, 30 Nov 2020 23:54:45 +0100 Subject: [PATCH] utils: Add eval-with and eval1-with. --- utils.rkt | 32 ++++++++++++++++++++++++++++++-- 1 file changed, 30 insertions(+), 2 deletions(-) diff --git a/utils.rkt b/utils.rkt index 17b8ccc..4087f47 100644 --- a/utils.rkt +++ b/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)))