From 6103097fe50ded377d18a3b1d970009b218dab99 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= <georges.duperon@gmail.com>
Date: Sun, 11 Sep 2016 13:55:45 +0200
Subject: [PATCH] Quick hack to support heterogeneous let forms.

---
 test/define-pass.rkt        | 50 +++++++++++++++++++++++--------------
 trivial/define.rkt          | 24 +++++++++++++++++-
 trivial/define/no-colon.rkt |  2 +-
 3 files changed, 55 insertions(+), 21 deletions(-)

diff --git a/test/define-pass.rkt b/test/define-pass.rkt
index 672fa4a..cea0273 100644
--- a/test/define-pass.rkt
+++ b/test/define-pass.rkt
@@ -4,6 +4,7 @@
   trivial/format
   trivial/function
   trivial/math
+  trivial/list
   trivial/regexp
   trivial/vector)
 
@@ -11,30 +12,30 @@
   (require typed/rackunit typed/racket/class)
 
   (check-equal?
-    (let ()
-      (define: n 3) ;; TODO define is broken
-      (let: ([m n])
-        (ann (-: m n) Zero)))
-    0)
+   (let ()
+     (define: n 3) ;; TODO define is broken
+     (let: ([m n])
+       (ann (-: m n) Zero)))
+   0)
 
   (check-equal?
-    (let: ([x (regexp: "(a*)(b*)")])
-      (let ([m (regexp-match: x "aaabbb")])
-        (if m (string-append (cadr m) (caddr m)) "")))
-    "aaabbb")
+   (let: ([x (regexp: "(a*)(b*)")])
+     (let ([m (regexp-match: x "aaabbb")])
+       (if m (string-append (cadr m) (caddr m)) "")))
+   "aaabbb")
 
   (check-equal?
-    (let: ([v '#(3 9 2)])
-      (ann (-: (vector-length: v) 3) Zero))
-    0)
+   (let: ([v '#(3 9 2)])
+     (ann (-: (vector-length: v) 3) Zero))
+   0)
 
   (check-equal?
-    (let: ([f (lambda ([x : String] [y : Integer])
-                (format: "hello(~a) and ~b" x y))])
-      (let: ([xs '("hi" "hi" "HI")]
-             [ys '(4 3 1)])
-      (map: f xs ys)))
-    '("hello(hi) and 100" "hello(hi) and 11" "hello(HI) and 1"))
+   (let: ([f (lambda ([x : String] [y : Integer])
+               (format: "hello(~a) and ~b" x y))])
+     (let: ([xs '("hi" "hi" "HI")]
+            [ys '(4 3 1)])
+       (map: f xs ys)))
+   '("hello(hi) and 100" "hello(hi) and 11" "hello(HI) and 1"))
 
   ;; Should be okay with "Indiana-style" defines
   (let ()
@@ -51,4 +52,15 @@
         (define/public (yolo)
           (new f%))))
     (check-false (not (new f%))))
-)
+
+  
+  ;; let*
+  (let*: ([v (list 1 2 3)]
+          [w v]
+          [k 42])
+    (ann (length: w) 3))
+
+  ;; let with different kinds of bindings
+  (let: ([v (list 1 2 3)]
+         [k 42])
+    (ann (length: v) 3)))
diff --git a/trivial/define.rkt b/trivial/define.rkt
index 6b8726e..ed80035 100644
--- a/trivial/define.rkt
+++ b/trivial/define.rkt
@@ -1,7 +1,9 @@
 #lang typed/racket/base
 
 (provide
-  define: let:
+  define:
+  (rename-out [let:: let:])
+  let*:
   (all-from-out trivial/private/set-bang)
 )
 
@@ -47,3 +49,23 @@
         (lst-let stx)
         (rx-let stx)
         (vec-let stx)))))
+
+(define-syntax (let*: stx)
+  (syntax-case stx ()
+    [(_ ([v b]) . body)
+     #'(let: ([v b])
+         . body)]
+    [(_ ([v b] [vv bb] ...) . body)
+     #'(let: ([v b])
+         (let*: ([vv bb] ...)
+           . body))]))
+
+(define-syntax (let:: stx)
+  (syntax-case stx ()
+    [(_ ([v b]) . body)
+     #'(let: ([v b])
+         . body)]
+    [(_ ([v b] [vv bb] ...) . body)
+     #'(let: ([tmp b])
+         (let*: ([vv bb] ...)
+           (let: ([v tmp]) . body)))]))
\ No newline at end of file
diff --git a/trivial/define/no-colon.rkt b/trivial/define/no-colon.rkt
index 7299d83..764a3c6 100644
--- a/trivial/define/no-colon.rkt
+++ b/trivial/define/no-colon.rkt
@@ -1,4 +1,4 @@
 #lang typed/racket/base
 
-(provide (rename-out [define: define] [let: let]))
+(provide (rename-out [define: define] [let: let] [let*: let*]))
 (require trivial/define)