utils: Move auto-hash-ref/explicit and auto-hash-ref/: to the typed section.

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}

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