Skip to content

Commit abbdf18

Browse files
lwhjpsamth
authored andcommitted
Support #:result clause in for/fold and for/list
Bumping version since the API has been updated
1 parent 1ed1ecd commit abbdf18

File tree

11 files changed

+118
-23
lines changed

11 files changed

+118
-23
lines changed

typed-racket-doc/info.rkt

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,7 @@
1313
"at-exp-lib"
1414
("scribble-lib" #:version "1.16")
1515
"pict-lib"
16-
("typed-racket-lib" #:version "1.10")
16+
("typed-racket-lib" #:version "1.11")
1717
"typed-racket-compatibility"
1818
("typed-racket-more" #:version "1.10")
1919
"racket-doc"
@@ -26,4 +26,4 @@
2626

2727
(define pkg-authors '(samth stamourv))
2828

29-
(define version "1.10")
29+
(define version "1.11")

typed-racket-doc/typed-racket/scribblings/reference/special-forms.scrbl

Lines changed: 14 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -262,26 +262,34 @@ Like the above, except they are not yet supported by the typechecker.
262262
}
263263

264264
@deftogether[[
265-
@defform[(for/lists type-ann-maybe ([id : t] ...)
265+
@defform[(for/lists type-ann-maybe ([id : t] ... maybe-result)
266266
(for-clause ...)
267267
expr ...+)]
268-
@defform[(for/fold type-ann-maybe ([id : t init-expr] ...)
268+
@defform[(for/fold type-ann-maybe ([id : t init-expr] ... maybe-result)
269269
(for-clause ...)
270-
expr ...+)]]]{
270+
expr ...+)
271+
#:grammar
272+
([maybe-result (code:line)
273+
(code:line #:result result-expr)])]]]{
271274
These behave like their non-annotated counterparts. Unlike the above,
272275
@racket[#:when] clauses can be used freely with these.
276+
@history[#:changed "1.11" @elem{Added the @racket[#:result] form.}]
273277
}
274278

275279
@deftogether[[
276280
@defform[(for* void-ann-maybe (for-clause ...)
277281
expr ...+)]
278-
@defform[(for*/lists type-ann-maybe ([id : t] ...)
282+
@defform[(for*/lists type-ann-maybe ([id : t] ... maybe-result)
279283
(for-clause ...)
280284
expr ...+)]
281-
@defform[(for*/fold type-ann-maybe ([id : t init-expr] ...)
285+
@defform[(for*/fold type-ann-maybe ([id : t init-expr] ... maybe-result)
282286
(for-clause ...)
283-
expr ...+)]]]{
287+
expr ...+)
288+
#:grammar
289+
([maybe-result (code:line)
290+
(code:line #:result result-expr)])]]]{
284291
These behave like their non-annotated counterparts.
292+
@history[#:changed "1.11" @elem{Added the @racket[#:result] form.}]
285293
}
286294

287295
@defform/subs[(do : u ([id : t init-expr step-expr-maybe] ...)

typed-racket-lib/info.rkt

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -12,4 +12,4 @@
1212

1313
(define pkg-authors '(samth stamourv))
1414

15-
(define version "1.10")
15+
(define version "1.11")

typed-racket-lib/typed-racket/base-env/for-clauses.rkt

Lines changed: 6 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -36,7 +36,11 @@
3636
#:attributes (ann-name init ty)
3737
(pattern (:optionally-annotated-name init:expr)))
3838

39+
(define-splicing-syntax-class result-clause
40+
#:description "result clause"
41+
(pattern (~seq #:result result-expr:expr)))
42+
3943
(define-syntax-class accumulator-bindings
4044
#:description "accumumulator bindings"
41-
#:attributes ((ann-name 1) (init 1) (ty 1))
42-
(pattern (:accumulator-binding ...)))
45+
#:attributes ((ann-name 1) (init 1) (ty 1) result)
46+
(pattern (:accumulator-binding ... (~optional result:result-clause))))

typed-racket-lib/typed-racket/base-env/prims.rkt

Lines changed: 11 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -398,19 +398,19 @@ the typed racket language.
398398
(define-syntax (for/lists: stx)
399399
(syntax-parse stx
400400
[(_ a1:optional-standalone-annotation*
401-
(var:optionally-annotated-formal ...)
401+
(var:optionally-annotated-formal ... (~optional result:result-clause))
402402
clause:for-clauses
403403
a2:optional-standalone-annotation*
404404
c ...)
405405
(define all-typed? (andmap values (attribute var.ty)))
406406
(define for-stx
407407
(quasisyntax/loc stx
408-
(for/lists (var.ann-name ...)
408+
(for/lists (var.ann-name ... (~@ . (~? result ())))
409409
(clause.expand ... ...)
410410
c ...)))
411411
((attribute a1.annotate)
412412
((attribute a2.annotate)
413-
(if all-typed?
413+
(if (and all-typed? (not (attribute result)))
414414
(add-ann
415415
for-stx
416416
#'(values var.ty ...))
@@ -425,12 +425,12 @@ the typed racket language.
425425
(define all-typed? (andmap values (attribute accum.ty)))
426426
(define for-stx
427427
(quasisyntax/loc stx
428-
(for/fold ((accum.ann-name accum.init) ...)
428+
(for/fold ((accum.ann-name accum.init) ... (~@ . (~? accum.result ())))
429429
(clause.expand ... ...)
430430
c ...)))
431431
((attribute a1.annotate)
432432
((attribute a2.annotate)
433-
(if all-typed?
433+
(if (and all-typed? (not (attribute accum.result)))
434434
(add-ann
435435
for-stx
436436
#'(values accum.ty ...))
@@ -476,37 +476,37 @@ the typed racket language.
476476
(define-syntax (for*/lists: stx)
477477
(syntax-parse stx
478478
[(_ a1:optional-standalone-annotation*
479-
((var:optionally-annotated-name) ...)
479+
((var:optionally-annotated-name) ... (~optional result:result-clause))
480480
clause:for-clauses
481481
a2:optional-standalone-annotation*
482482
c ...)
483483
(define all-typed? (andmap values (attribute var.ty)))
484484
(define for-stx
485485
(quasisyntax/loc stx
486-
(for/lists (var.ann-name ...)
486+
(for/lists (var.ann-name ... (~@ . (~? result ())))
487487
(clause.expand* ... ...)
488488
c ...)))
489489
((attribute a1.annotate)
490490
((attribute a2.annotate)
491-
(if all-typed?
491+
(if (and all-typed? (not (attribute result)))
492492
(add-ann for-stx #'(values var.ty ...))
493493
for-stx)))]))
494494
(define-syntax (for*/fold: stx)
495495
(syntax-parse stx #:literals (:)
496496
[(_ a1:optional-standalone-annotation*
497-
((var:optionally-annotated-name init:expr) ...)
497+
((var:optionally-annotated-name init:expr) ... (~optional result:result-clause))
498498
clause:for-clauses
499499
a2:optional-standalone-annotation*
500500
c ...)
501501
(define all-typed? (andmap values (attribute var.ty)))
502502
(define for-stx
503503
(quasisyntax/loc stx
504-
(for/fold ((var.ann-name init) ...)
504+
(for/fold ((var.ann-name init) ... (~@ . (~? result ())))
505505
(clause.expand* ... ...)
506506
c ...)))
507507
((attribute a1.annotate)
508508
((attribute a2.annotate)
509-
(if all-typed?
509+
(if (and all-typed? (not (attribute result)))
510510
(add-ann for-stx #'(values var.ty ...))
511511
for-stx)))]))
512512

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
#lang typed/racket
2+
(for/lists : (Values (Listof Integer) (Listof Integer))
3+
([l1 : (Listof Integer)]
4+
[l2 : (Listof Integer)]
5+
#:result (+ (length l1) (length l2)))
6+
([x (in-range 3)])
7+
(values x x))
Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
#lang typed/racket
2+
(for*/lists : (Values (Listof Integer) (Listof Integer))
3+
([l1 : (Listof Integer)]
4+
[l2 : (Listof Integer)]
5+
#:result (append l1 l2))
6+
([x (in-range 3)])
7+
(values x x))
Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
#lang typed/racket
2+
(for/fold : Integer
3+
([x : Integer 0]
4+
#:result (number->string x))
5+
([y (in-range 3)])
6+
(+ x y))
Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
#lang typed/racket
2+
(for*/fold : (Values Integer Integer)
3+
([x : Integer 0]
4+
[y : Integer 0]
5+
#:result (+ x y))
6+
([i (in-range 3)]
7+
[j (in-range 3)])
8+
(values (+ x i) (+ y i j)))
Lines changed: 55 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,55 @@
1+
#lang typed/racket
2+
3+
(require typed/rackunit)
4+
5+
(check-equal?
6+
(for/lists ([l1 : (Listof Integer)]
7+
[l2 : (Listof Integer)]
8+
#:result (append l1 l2))
9+
([x (in-range 3)])
10+
(values x (add1 x)))
11+
'(0 1 2 1 2 3))
12+
13+
(check-equal?
14+
(for/lists : Integer
15+
([l1 : (Listof Integer)]
16+
[l2 : (Listof Integer)]
17+
#:result (+ (length l1) (length l2)))
18+
([x (in-range 3)])
19+
(values x (add1 x)))
20+
6)
21+
22+
(check-equal?
23+
(let-values ([(v1 v2)
24+
(for/lists ([l1 : (Listof Integer)]
25+
[l2 : (Listof Integer)]
26+
#:result (values l2 l1))
27+
([x (in-range 3)])
28+
(values x (add1 x)))])
29+
(append v1 v2))
30+
'(1 2 3 0 1 2))
31+
32+
(check-equal?
33+
(for/fold ([x : Integer 0]
34+
#:result (number->string x))
35+
([y (in-range 3)])
36+
(+ x y))
37+
"3")
38+
39+
(check-equal?
40+
(for/fold : String
41+
([x : Integer 1]
42+
#:result (number->string x))
43+
([y (in-range 3)])
44+
(+ x y))
45+
"4")
46+
47+
(check-equal?
48+
(for*/fold : Integer
49+
([x : Integer 0]
50+
[y : Integer 0]
51+
#:result (+ x y))
52+
([i (in-range 3)]
53+
[j (in-range 3)])
54+
(values (+ x i) (+ y i j)))
55+
27)

0 commit comments

Comments
 (0)