Add lambda/:, λ/:, and define/:.

scribblings/utils.scrbl

@@ -194,6 +194,39 @@ Note that only one expression can be supplied in the body.
 
 }
 
+@deftogether[(@defform*[((lambda/: body) (lambda/: type body))]
+              @defform*[((λ/: body) (λ/: type body))])]{
+
+Defines an anonymous function with the body @racket[body], taking a hash table
+as an argument, and applying @racket[auto-hash-ref/:] to @racket[body] in the
+context of this hash table.
+
+@ex[
+(let ([ht (hash 'a 1 'b 2)])
+  ((λ/: (+ :a :b)) ht))
+]
+
+If the optional annotation @racket[type] is specified, the only argument of the
+resulting lambda will be of type @racket[type].
+
+@ex[
+(let ([ht (hash 'a 1 'b 2)])
+  ((λ/: (HashTable Symbol Natural) (+ :a :b)) ht))
+]}
+
+@defform*[((define/: name body)
+           (define/: name type body))]{
+
+A shortcut for @racket[(define name (lambda/: body))], with the optional
+type annotation.
+
+@ex[
+(let ([ht (hash 'a 1 'b 2)])
+  (: f (-> (HashTable Symbol Natural) Natural))
+  (define/: f (+ :a :b))
+  (f ht))
+]}
+
 @section{Analysis of quoted expressions}
 
 @defproc[(extract-symbols [form Any]) (Listof Symbol)]{

utils.rkt

@@ -1,7 +1,7 @@
 #lang typed/racket
 
 (require typed/graph typed-compose typed/racket/stream syntax/parse/define
-         (for-syntax syntax/parse racket/list))
+         (for-syntax syntax/parse racket/syntax racket/list))
 
 (provide
  Variable VariableMapping GeneralPair
@@ -9,6 +9,7 @@
  assert-type for/first/typed for*/first/typed define/abstract/error
  relax-arg-type/any
  eval-with eval1-with auto-hash-ref/explicit auto-hash-ref/:
+ lambda/: λ/: define/:
  extract-symbols any->string stringify-variable-mapping string->any
  handle-org-booleans map-sexp read-org-sexp unorg unstringify-pairs
  read-org-variable-mapping unorgv read-symbol-list drop-first-last
@@ -140,6 +141,36 @@
     (check-equal? (auto-hash-ref/: ht2 (+ :a (* 2 :b)))
                   5)))
 
+(define-syntax-parser lambda/:
+  [(_ body:expr)
+   #:with ht (format-id #'body "ht")
+   #'(lambda (ht) (auto-hash-ref/: ht body))]
+  [(_ type:expr body:expr)
+   #:with ht (format-id #'body "ht")
+   #'(lambda ([ht : type]) (auto-hash-ref/: ht body))])
+
+(define-syntax-parser λ/:
+  [(_ body:expr) #'(lambda/: body)]
+  [(_ type:expr body:expr) #'(lambda/: type body)])
+
+(define-syntax-parser define/:
+  [(_ name:id body:expr) #'(define name (λ/: body))]
+  [(_ name:id type:expr body:expr) #'(define name (λ/: type body))])
+
+(module+ test
+  (test-case "lambda/:, λ/:, define/:"
+    (define st : (HashTable Symbol Integer) (hash 'a 1 'b 2))
+    (check-equal? ((lambda/: (+ :a :b)) st) 3)
+    (check-equal? ((lambda/: (HashTable Symbol Integer) (+ :a :b)) st) 3)
+    (check-equal? ((λ/: (HashTable Symbol Integer) (+ :a :b)) st) 3)
+
+    (: f1 (-> (HashTable Symbol Integer) Integer))
+    (define/: f1 (+ :a :b))
+    (check-equal? (f1 st) 3)
+
+    (define/: f2 (HashTable Symbol Integer) (+ :a :b))
+    (check-equal? (f2 st) 3)))
+
 (: extract-symbols (-> Any (Listof Symbol)))
 (define (extract-symbols form)
   (: extract-rec (-> Any (Listof Any)))