Added the for/lists: and for/fold: macros.

original commit: 1ec6bd448b4dc325603ed41ec81cf04cc33866b8
This commit is contained in:
Vincent St-Amour 2010-05-27 16:46:10 -04:00
parent 7ef168c27d
commit 48c3edca84
2 changed files with 50 additions and 8 deletions

View File

@ -4,19 +4,20 @@
"annotate-classes.rkt"
(for-template racket/base))
(provide convert-for-clauses)
(provide convert-for-clauses
for-clause)
;; we need handle #:when clauses manually because we need to annotate
;; the type of each nested for
(define (convert-for-clauses name clauses body ty)
(let loop ((clauses clauses))
(define-splicing-syntax-class for-clause
;; single-valued seq-expr
(pattern (var:annotated-name seq-expr:expr)
#:with expand #'(var.ann-name seq-expr))
;; multi-valued seq-expr
(pattern ((v:annotated-name ...) seq-expr:expr)
#:with expand #'((v.ann-name ...) seq-expr)))
(define-syntax-class for-clause
;; single-valued seq-expr
(pattern (var:annotated-name seq-expr:expr)
#:with expand #'(var.ann-name seq-expr))
;; multi-valued seq-expr
(pattern ((v:annotated-name ...) seq-expr:expr)
#:with expand #'((v.ann-name ...) seq-expr)))
(syntax-parse clauses
[(head:for-clause next:for-clause ... #:when rest ...)
(syntax-property
@ -42,3 +43,14 @@
(quasisyntax/loc clauses
(when guard
#,(loop #'(rest ...))))])))
(define-splicing-syntax-class for-clause
;; single-valued seq-expr
(pattern (var:annotated-name seq-expr:expr)
#:with (expand ...) (list #'(var.ann-name seq-expr)))
;; multi-valued seq-expr
(pattern ((v:annotated-name ...) seq-expr:expr)
#:with (expand ...) (list #'((v.ann-name ...) seq-expr)))
;; when clause
(pattern (~seq #:when guard:expr)
#:with (expand ...) (list #'#:when #'guard)))

View File

@ -403,6 +403,36 @@ This file defines two sorts of primitives. All of them are provided into any mod
(for/first: for/first)
(for/last: for/last))
;; these 2 don't expand into nested for/X:s, #:when clauses are handled during
;; the expansion of the untyped versions of these macros
;; for this reason, uses of these macros with #:when clauses may not typecheck
(define-syntax (for/lists: stx)
(syntax-parse stx #:literals (:)
[(_ : ty
((var:annotated-name) ...)
(clause:for-clause ...)
c:expr ...)
(syntax-property
(syntax/loc stx
(for/lists (var.ann-name ...)
(clause.expand ... ...)
c ...))
'type-ascription
#'ty)]))
(define-syntax (for/fold: stx)
(syntax-parse stx #:literals (:)
[(_ : ty
((var:annotated-name init:expr) ...)
(clause:for-clause ...)
c:expr ...)
(syntax-property
(syntax/loc stx
(for/fold ((var.ann-name init) ...)
(clause.expand ... ...)
c ...))
'type-ascription
#'ty)]))
(define-syntax (provide: stx)
(syntax-parse stx
[(_ [i:id t] ...)