Quick hack to support heterogeneous let forms.
This commit is contained in:
parent
a8c4fd4fcf
commit
6103097fe5
|
@ -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)))
|
||||
|
|
|
@ -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)))]))
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue
Block a user