From 28fdc2332457c3ac94e421e3b9c14cf06f0ce225 Mon Sep 17 00:00:00 2001
From: Sergiu Ivanov <sivanov@colimite.fr>
Date: Sun, 16 Jan 2022 23:10:08 +0100
Subject: [PATCH] utils: Type eval-with and eval1-with.

---
 scribblings/utils.scrbl | 18 +++++++++--
 utils.rkt               | 66 +++++++++++++++++------------------------
 2 files changed, 42 insertions(+), 42 deletions(-)

diff --git a/scribblings/utils.scrbl b/scribblings/utils.scrbl
index 0ab85c1..d1602e8 100644
--- a/scribblings/utils.scrbl
+++ b/scribblings/utils.scrbl
@@ -1,6 +1,8 @@
 #lang scribble/manual
 @(require scribble/example racket/sandbox
-	  (for-label racket graph "../utils.rkt"))
+	  (for-label racket graph (submod "../utils.rkt" typed)
+	  	     (only-in typed/racket/base
+		     	      Any AnyValues)))
 
 @title[#:tag "utils"]{dds/utils: Various Utilities}
 
@@ -19,7 +21,7 @@ module, so you cannot yet use the types directly.
   (parameterize ([sandbox-output 'string]
   		 [sandbox-error-output 'string]
 		 [sandbox-memory-limit 50])
-   (make-evaluator 'racket/base #:requires '("utils.rkt"))))
+   (make-evaluator 'typed/racket/base #:requires '((submod "utils.rkt" typed)))))
 
 @section{Base types}
 
@@ -42,7 +44,7 @@ This section defines some utilities to streamline the usage of hash tables
 mapping symbols to values.  The goal is essentially to avoid having to write
 explicit @racket[hash-ref] calls.
 
-@defproc[(eval-with [ht variable-mapping?] [expr any/c]) any]{
+@defproc[(eval-with [ht (VariableMapping Any)] [expr Any]) AnyValues]{
 
 Temporarily injects the mappings from the given hash table as bindings in
 a namespace including @racket[racket/base] and then evaluates the expression.
@@ -63,6 +65,16 @@ missing identifier:
   (eval-with ht '(+ b z a 1)))
 )]}
 
+@defproc[(eval1-with [ht (VariableMapping Any)] [expr Any]) Any]{
+
+Like @racket[eval-with], but returns only the first value computed by
+@racket[expr].
+
+@examples[#:eval utils-evaluator
+(let ([ht (hash 'a 1 'b 1)])
+  (eval1-with ht '(+ b a 1)))
+]}
+
 @section{Analysis of quoted expressions}
 
 @section{Org-mode interoperability}
diff --git a/utils.rkt b/utils.rkt
index cc7ba79..fe7aed5 100644
--- a/utils.rkt
+++ b/utils.rkt
@@ -11,21 +11,43 @@
 ;;; Typed section.
 
 (module typed typed/racket
-  (require typed/graph
+  (require typed/graph typed/rackunit
            (for-syntax syntax/parse racket/list))
-  (provide (all-defined-out))
+
+  (provide eval-with eval1-with)
 
   (define-type Variable Symbol)
-  (define-type (VariableMapping A) (Immutable-HashTable Variable A)))
+  (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))))
+
 
 (require 'typed)
+(provide eval-with eval1-with)
 
 ;;; Untyped section.
 
 (provide
  ;; Functions
- (contract-out [eval-with (-> variable-mapping? any/c any)]
-               [extract-symbols (-> any/c list?)]
+ (contract-out [extract-symbols (-> any/c list?)]
                [any->string (-> any/c string?)]
                [stringify-variable-mapping (-> variable-mapping? string-variable-mapping?)]
                [string->any (-> string? any/c)]
@@ -171,40 +193,6 @@
           (string->symbol (substring x-str 1))
           x))))
 
-;;; Temporarily injects the mappings from the given hash table as
-;;; bindings in a namespace including racket/base 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)))
-;;;
-(define (eval-with ht expr)
-  (parameterize ([current-namespace (make-base-namespace)])
-    (for ([(x val) ht]) (namespace-set-variable-value! x val))
-    (eval expr)))
-
-(module+ test
-  (test-case "eval-with"
-    (check-equal? (let ([ht #hash((a . 1) (b . 1))])
-                    (eval-with ht '(+ b a 1)))
-                  3)))
-
-;;; Same as eval-with, but returns only the first value produced by
-;;; the evaluated expression.
-(define (eval-with1 ht expr)
-  (let ([vals (call-with-values (λ () (eval-with ht expr))
-                                (λ vals vals))])
-    (car vals)))
-
 
 ;;; ==============================
 ;;; Analysis of quoted expressions