Quick hack to support heterogeneous let forms.

This commit is contained in:
Georges Dupéron 2016-09-11 13:55:45 +02:00
parent a8c4fd4fcf
commit 6103097fe5
3 changed files with 55 additions and 21 deletions

View File

@ -4,6 +4,7 @@
trivial/format trivial/format
trivial/function trivial/function
trivial/math trivial/math
trivial/list
trivial/regexp trivial/regexp
trivial/vector) trivial/vector)
@ -11,30 +12,30 @@
(require typed/rackunit typed/racket/class) (require typed/rackunit typed/racket/class)
(check-equal? (check-equal?
(let () (let ()
(define: n 3) ;; TODO define is broken (define: n 3) ;; TODO define is broken
(let: ([m n]) (let: ([m n])
(ann (-: m n) Zero))) (ann (-: m n) Zero)))
0) 0)
(check-equal? (check-equal?
(let: ([x (regexp: "(a*)(b*)")]) (let: ([x (regexp: "(a*)(b*)")])
(let ([m (regexp-match: x "aaabbb")]) (let ([m (regexp-match: x "aaabbb")])
(if m (string-append (cadr m) (caddr m)) ""))) (if m (string-append (cadr m) (caddr m)) "")))
"aaabbb") "aaabbb")
(check-equal? (check-equal?
(let: ([v '#(3 9 2)]) (let: ([v '#(3 9 2)])
(ann (-: (vector-length: v) 3) Zero)) (ann (-: (vector-length: v) 3) Zero))
0) 0)
(check-equal? (check-equal?
(let: ([f (lambda ([x : String] [y : Integer]) (let: ([f (lambda ([x : String] [y : Integer])
(format: "hello(~a) and ~b" x y))]) (format: "hello(~a) and ~b" x y))])
(let: ([xs '("hi" "hi" "HI")] (let: ([xs '("hi" "hi" "HI")]
[ys '(4 3 1)]) [ys '(4 3 1)])
(map: f xs ys))) (map: f xs ys)))
'("hello(hi) and 100" "hello(hi) and 11" "hello(HI) and 1")) '("hello(hi) and 100" "hello(hi) and 11" "hello(HI) and 1"))
;; Should be okay with "Indiana-style" defines ;; Should be okay with "Indiana-style" defines
(let () (let ()
@ -51,4 +52,15 @@
(define/public (yolo) (define/public (yolo)
(new f%)))) (new f%))))
(check-false (not (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)))

View File

@ -1,7 +1,9 @@
#lang typed/racket/base #lang typed/racket/base
(provide (provide
define: let: define:
(rename-out [let:: let:])
let*:
(all-from-out trivial/private/set-bang) (all-from-out trivial/private/set-bang)
) )
@ -47,3 +49,23 @@
(lst-let stx) (lst-let stx)
(rx-let stx) (rx-let stx)
(vec-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)))]))

View File

@ -1,4 +1,4 @@
#lang typed/racket/base #lang typed/racket/base
(provide (rename-out [define: define] [let: let])) (provide (rename-out [define: define] [let: let] [let*: let*]))
(require trivial/define) (require trivial/define)