From d7d9274bc9dea0073812683b222f6d37983fba38 Mon Sep 17 00:00:00 2001
From: Sergiu Ivanov <sivanov@colimite.fr>
Date: Sun, 6 Nov 2022 22:25:27 +0100
Subject: [PATCH] =?UTF-8?q?Add=20lambda/:,=20=CE=BB/:,=20and=20define/:.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 scribblings/utils.scrbl | 33 +++++++++++++++++++++++++++++++++
 utils.rkt               | 33 ++++++++++++++++++++++++++++++++-
 2 files changed, 65 insertions(+), 1 deletion(-)

diff --git a/scribblings/utils.scrbl b/scribblings/utils.scrbl
index 739968f..0dad8ee 100644
--- a/scribblings/utils.scrbl
+++ b/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)]{
diff --git a/utils.rkt b/utils.rkt
index 2ce6685..2180567 100644
--- a/utils.rkt
+++ b/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)))