utils: Move auto-hash-ref/explicit and auto-hash-ref/: to the typed section.
This commit is contained in:
parent
752d173279
commit
85d60c6a9b
2 changed files with 101 additions and 99 deletions
|
@ -79,6 +79,41 @@ Like @racket[eval-with], but returns only the first value computed by
|
||||||
(eval1-with ht '(+ b a 1)))
|
(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{Analysis of quoted expressions}
|
||||||
|
|
||||||
@section{Org-mode interoperability}
|
@section{Org-mode interoperability}
|
||||||
|
|
165
utils.rkt
165
utils.rkt
|
@ -14,7 +14,7 @@
|
||||||
(require typed/graph typed/rackunit
|
(require typed/graph typed/rackunit
|
||||||
(for-syntax syntax/parse racket/list))
|
(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 Variable Symbol)
|
||||||
(define-type (VariableMapping A) (Immutable-HashTable Variable A))
|
(define-type (VariableMapping A) (Immutable-HashTable Variable A))
|
||||||
|
@ -37,11 +37,73 @@
|
||||||
(define ht : (VariableMapping Integer) (hash 'a 1 'b 2))
|
(define ht : (VariableMapping Integer) (hash 'a 1 'b 2))
|
||||||
(define expr : Any '(+ a b 1))
|
(define expr : Any '(+ a b 1))
|
||||||
(check-equal? (eval1-with ht expr)
|
(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)
|
(require 'typed)
|
||||||
(provide eval-with eval1-with)
|
(provide eval-with eval1-with auto-hash-ref/explicit auto-hash-ref/:)
|
||||||
|
|
||||||
;;; Untyped section.
|
;;; Untyped section.
|
||||||
|
|
||||||
|
@ -90,109 +152,14 @@
|
||||||
;; Contracts
|
;; Contracts
|
||||||
(contract-out [variable-mapping? contract?]
|
(contract-out [variable-mapping? contract?]
|
||||||
[string-variable-mapping? contract?]
|
[string-variable-mapping? contract?]
|
||||||
[general-pair/c (-> contract? contract? contract?)])
|
[general-pair/c (-> contract? contract? contract?)]))
|
||||||
;; Syntax
|
|
||||||
auto-hash-ref/explicit auto-hash-ref/:)
|
|
||||||
|
|
||||||
(module+ test
|
(module+ test
|
||||||
(require rackunit))
|
(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))
|
(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
|
;;; Analysis of quoted expressions
|
||||||
|
|
Loading…
Reference in a new issue