suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Allow #:unless' in for:'.

Browse Source 
Also allow `#:break' and `#:final' in all the `for:' macros.

Unfortunately, the expansion of `#:break' and `#:final' cannot be
typechecked at the moment.
This commit is contained in:
Vincent St-Amour 2012-12-12 14:19:14 -05:00
parent 009293885b
commit ec673fd58d
3 changed files with 94 additions and 76 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
collects/tests/typed-racket/succeed/for.rkt
View File

@ -199,3 +199,28 @@
([i : Natural (ann 4 Integer)]) ([i : Natural (ann 4 Integer)])
i) i)
6) 6)
(check string=?
(with-output-to-string
(lambda ()
(for: ([x 10] #:unless (> x 3)) (display x))))
"0123")
;; break and final clauses
;; TODO typechecker can't handle these
;; (check string=?
;; (with-output-to-string
;; (lambda ()
;; (for: ([x 10] #:break (> x 3)) (display x))))
;; "0123")
;; (check string=?
;; (with-output-to-string
;; (lambda ()
;; (for: ([x 10]) #:break (> x 3) (display x))))
;; "0123")
;; (check =
;; (for/sum: : Integer ([x : Integer 10] #:break (> x 3)) (ann x Integer))
;; 6)
;; (check =
;; (for/sum: : Integer ([x 10] #:final (> x 3)) x)
;; 10)

53
collects/typed-racket/base-env/for-clauses.rkt
View File

@ -6,41 +6,22 @@
(provide (all-defined-out)) (provide (all-defined-out))
(define-splicing-syntax-class for-clause
;; single-valued seq-expr
(pattern (~and c (var:optionally-annotated-name seq-expr:expr))
#:with (expand ...) (list (syntax/loc
#'c
(var.ann-name seq-expr))))
;; multi-valued seq-expr
;; currently disabled because it triggers an internal error in the typechecker
#;(pattern (~and c (((v:optionally-annotated-name) ...) seq-expr:expr))
#:with (expand ...) (list (syntax/loc
#'c
((v.ann-name ...) seq-expr))))
;; when clause
(pattern (~seq #:when guard:expr)
#:with (expand ...) (list #'#:when #'guard))
(pattern (~seq #:unless guard:expr)
#:with (expand ...) (list #'#:unless #'guard)))
;; intersperses "#:when #t" clauses to emulate the for* variants' semantics ;; intersperses "#:when #t" clauses to emulate the for* variants' semantics
(define-splicing-syntax-class for*-clause (define-splicing-syntax-class for-clause
;; single-valued seq-expr ;; single-valued seq-expr
(pattern (~and c (var:optionally-annotated-name seq-expr:expr)) (pattern (~and c (var:optionally-annotated-name seq-expr:expr))
#:with (expand ...) (list (syntax/loc #:with (expand ...) #`(#,(syntax/loc #'c
#'c (var.ann-name seq-expr)))
(var.ann-name seq-expr)) #:with (expand* ...) #'(expand ... #:when #t))
#'#:when #'#t)) ;; multi-valued seq-expr
;; multi-valued seq-expr ;; currently disabled because it triggers an internal error in the typechecker
;; currently disabled because it triggers an internal error in the typechecker ;; (pattern (~and c (((v:optionally-annotated-name) ...) seq-expr:expr))
#;(pattern (~and c (((v:optionally-annotated-name) ...) seq-expr:expr)) ;; #:with (expand ...) (list (syntax/loc #'c
#:with (expand ...) (list (quasisyntax/loc ;; ((v.ann-name ...) seq-expr)))
#'c ;; #:with (expand* ...) (list (quasisyntax/loc #'c
((v.ann-name ...) seq-expr)) ;; ((v.ann-name ...) seq-expr))
#'#:when #'#t)) ;; #'#:when #'#t))
;; when clause ;; Note: #:break and #:final clauses don't ever typecheck
(pattern (~seq #:when guard:expr) (pattern (~seq (~and kw (~or #:when #:unless #:break #:final)) guard:expr)
#:with (expand ...) (list #'#:when #'guard)) #:with (expand ...) (list #'kw #'guard)
(pattern (~seq #:unless guard:expr) #:with (expand* ...) #'(expand ...)))
#:with (expand ...) (list #'#:unless #'guard)))

92
collects/typed-racket/base-env/prims.rkt
View File

@ -695,44 +695,54 @@ This file defines two sorts of primitives. All of them are provided into any mod
;; the annotation is not necessary (always of Void type), but kept ;; the annotation is not necessary (always of Void type), but kept
;; for consistency with the other for: macros ;; for consistency with the other for: macros
[(_ (~seq : Void) ... [(_ (~seq : Void) ...
clauses ; no need to annotate the type, it's always Void ;; c is not always an expression, could be a break-clause
c:expr ...) clauses c ...) ; no need to annotate the type, it's always Void
(let ((body (syntax-property #'(c ...) 'type-ascription #'Void))) (let ((body #`(; break-clause ...
#,@(syntax-property #'(c ...) 'type-ascription #'Void))))
(let loop ((clauses #'clauses)) (let loop ((clauses #'clauses))
(define-syntax-class for-clause (define-splicing-syntax-class for-clause
;; single-valued seq-expr ;; single-valued seq-expr
;; unlike the definitions in for-clauses.rkt, this does not include ;; unlike the definitions in for-clauses.rkt, this does not include
;; #:when clauses, which are handled separately here ;; #:when clauses, which are handled separately here
(pattern (var:optionally-annotated-name seq-expr:expr) (pattern (~seq (var:optionally-annotated-name seq-expr:expr))
#:with expand #'(var.ann-name seq-expr)) #:with (expand ...) #'((var.ann-name seq-expr)))
;; multi-valued seq-expr ;; multi-valued seq-expr
;; currently disabled because it triggers an internal error in the typechecker ;; currently disabled because it triggers an internal error in the typechecker
#;(pattern ((v:optionally-annotated-name ...) seq-expr:expr) ;; (pattern ((v:optionally-annotated-name ...) seq-expr:expr)
#:with expand #'((v.ann-name ...) seq-expr))) ;; #:with (expand ...) #'(((v.ann-name ...) seq-expr)))
;; break-clause, pass it directly
;; Note: these don't ever typecheck
(pattern (~seq (~and kw (~or #:break #:final)) guard-expr:expr)
#:with (expand ...) #'(kw guard-expr)))
(define-syntax-class for-kw
(pattern #:when
#:with replace-with #'when)
(pattern #:unless
#:with replace-with #'unless))
(syntax-parse clauses (syntax-parse clauses
[(head:for-clause next:for-clause ... #:when rest ...) [(head:for-clause next:for-clause ... kw:for-kw rest ...)
(syntax-property (syntax-property
(quasisyntax/loc stx (quasisyntax/loc stx
(for (for
(head.expand next.expand ...) (head.expand ... next.expand ... ...)
#,(loop #'(#:when rest ...)))) #,(loop #'(kw rest ...))))
'type-ascription 'type-ascription
#'Void)] #'Void)]
[(head:for-clause ...) ; we reached the end [(head:for-clause ...) ; we reached the end
(syntax-property (syntax-property
(quasisyntax/loc stx (quasisyntax/loc stx
(for (for
(head.expand ...) (head.expand ... ...)
#,@body)) #,@body))
'type-ascription 'type-ascription
#'Void)] #'Void)]
[(#:when guard) ; we end on a #:when clause [(kw:for-kw guard) ; we end on a keyword clause
(quasisyntax/loc stx (quasisyntax/loc stx
(when guard (kw.replace-with guard
#,@body))] #,@body))]
[(#:when guard rest ...) [(kw:for-kw guard rest ...)
(quasisyntax/loc stx (quasisyntax/loc stx
(when guard (kw.replace-with guard
#,(loop #'(rest ...))))])))])) #,(loop #'(rest ...))))])))]))
(define-for-syntax (maybe-annotate-body body ty) (define-for-syntax (maybe-annotate-body body ty)
@ -751,7 +761,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
(syntax-parse stx #:literals (:) (syntax-parse stx #:literals (:)
[(_ a:optional-standalone-annotation [(_ a:optional-standalone-annotation
(clause:for-clause ...) (clause:for-clause ...)
c:expr ...) c ...) ; c is not always an expression, can be a break-clause
(maybe-annotate-body (maybe-annotate-body
(quasisyntax/loc stx (quasisyntax/loc stx
(#,name (#,name
@ -783,7 +793,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
[(_ : ty [(_ : ty
((var:optionally-annotated-name) ...) ((var:optionally-annotated-name) ...)
(clause:for-clause ...) (clause:for-clause ...)
c:expr ...) c ...) ; c is not always an expression, can be a break-clause
(syntax-property (syntax-property
(quasisyntax/loc stx (quasisyntax/loc stx
(for/lists (var.ann-name ...) (for/lists (var.ann-name ...)
@ -793,7 +803,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
#'ty)] #'ty)]
[(_ ((var:annotated-name) ...) [(_ ((var:annotated-name) ...)
(clause:for-clause ...) (clause:for-clause ...)
c:expr ...) c ...)
(syntax-property (syntax-property
(quasisyntax/loc stx (quasisyntax/loc stx
(for/lists (var.ann-name ...) (for/lists (var.ann-name ...)
@ -806,7 +816,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
[(_ : ty [(_ : ty
((var:optionally-annotated-name init:expr) ...) ((var:optionally-annotated-name init:expr) ...)
(clause:for-clause ...) (clause:for-clause ...)
c:expr ...) c ...) ; c is not always an expression, can be a break-clause
(syntax-property (syntax-property
(quasisyntax/loc stx (quasisyntax/loc stx
(for/fold ((var.ann-name init) ...) (for/fold ((var.ann-name init) ...)
@ -816,7 +826,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
#'ty)] #'ty)]
[(_ ((var:annotated-name init:expr) ...) [(_ ((var:annotated-name init:expr) ...)
(clause:for-clause ...) (clause:for-clause ...)
c:expr ...) c ...)
(syntax-property (syntax-property
(quasisyntax/loc stx (quasisyntax/loc stx
(for/fold ((var.ann-name init) ...) (for/fold ((var.ann-name init) ...)
@ -829,10 +839,10 @@ This file defines two sorts of primitives. All of them are provided into any mod
(define-syntax (for*: stx) (define-syntax (for*: stx)
(syntax-parse stx #:literals (:) (syntax-parse stx #:literals (:)
[(_ (~seq : Void) ... [(_ (~seq : Void) ...
(clause:for*-clause ...) (clause:for-clause ...)
c:expr ...) c ...) ; c is not always an expression, can be a break-clause
(quasisyntax/loc stx (quasisyntax/loc stx
(for: (clause.expand ... ...) (for: (clause.expand* ... ...)
c ...))])) c ...))]))
;; These currently only typecheck in very limited cases. ;; These currently only typecheck in very limited cases.
@ -841,7 +851,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
(syntax-parse stx #:literals (:) (syntax-parse stx #:literals (:)
[(_ a:optional-standalone-annotation [(_ a:optional-standalone-annotation
(clause:for-clause ...) (clause:for-clause ...)
c:expr ...) c ...) ; c is not always an expression, can be a break-clause
(maybe-annotate-body (maybe-annotate-body
(quasisyntax/loc stx (quasisyntax/loc stx
(#,name (clause.expand ... ...) (#,name (clause.expand ... ...)
@ -867,22 +877,22 @@ This file defines two sorts of primitives. All of them are provided into any mod
(syntax-parse stx #:literals (:) (syntax-parse stx #:literals (:)
[(_ : ty [(_ : ty
((var:optionally-annotated-name) ...) ((var:optionally-annotated-name) ...)
(clause:for*-clause ...) (clause:for-clause ...)
c:expr ...) c ...) ; c is not always an expression, can be a break-clause
(syntax-property (syntax-property
(quasisyntax/loc stx (quasisyntax/loc stx
(for/lists (var.ann-name ...) (for/lists (var.ann-name ...)
(clause.expand ... ...) (clause.expand* ... ...)
c ...)) c ...))
'type-ascription 'type-ascription
#'ty)] #'ty)]
[(_ ((var:annotated-name) ...) [(_ ((var:annotated-name) ...)
(clause:for*-clause ...) (clause:for-clause ...)
c:expr ...) c ...)
(syntax-property (syntax-property
(quasisyntax/loc stx (quasisyntax/loc stx
(for/lists (var.ann-name ...) (for/lists (var.ann-name ...)
(clause.expand ... ...) (clause.expand* ... ...)
c ...)) c ...))
'type-ascription 'type-ascription
#'(values var.ty ...))])) #'(values var.ty ...))]))
@ -890,22 +900,22 @@ This file defines two sorts of primitives. All of them are provided into any mod
(syntax-parse stx #:literals (:) (syntax-parse stx #:literals (:)
[(_ : ty [(_ : ty
((var:optionally-annotated-name init:expr) ...) ((var:optionally-annotated-name init:expr) ...)
(clause:for*-clause ...) (clause:for-clause ...)
c:expr ...) c ...) ; c is not always an expression, can be a break-clause
(syntax-property (syntax-property
(quasisyntax/loc stx (quasisyntax/loc stx
(for/fold ((var.ann-name init) ...) (for/fold ((var.ann-name init) ...)
(clause.expand ... ...) (clause.expand* ... ...)
c ...)) c ...))
'type-ascription 'type-ascription
#'ty)] #'ty)]
[(_ ((var:annotated-name init:expr) ...) [(_ ((var:annotated-name init:expr) ...)
(clause:for*-clause ...) (clause:for-clause ...)
c:expr ...) c ...)
(syntax-property (syntax-property
(quasisyntax/loc stx (quasisyntax/loc stx
(for/fold ((var.ann-name init) ...) (for/fold ((var.ann-name init) ...)
(clause.expand ... ...) (clause.expand* ... ...)
c ...)) c ...))
'type-ascription 'type-ascription
#'(values var.ty ...))])) #'(values var.ty ...))]))
@ -916,7 +926,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
(syntax-parse stx #:literals (:) (syntax-parse stx #:literals (:)
[(_ : ty [(_ : ty
(clause:for-clause ...) (clause:for-clause ...)
c:expr ...) c ...) ; c is not always an expression, can be a break-clause
;; ty has to include exact 0, the initial value of the accumulator ;; ty has to include exact 0, the initial value of the accumulator
;; (to be consistent with Racket semantics). ;; (to be consistent with Racket semantics).
;; We can't just change the initial value to be 0.0 if we expect a ;; We can't just change the initial value to be 0.0 if we expect a
@ -940,7 +950,8 @@ This file defines two sorts of primitives. All of them are provided into any mod
(syntax-parse stx (syntax-parse stx
#:literals (:) #:literals (:)
((_ (~seq : return-annotation:expr) ((_ (~seq : return-annotation:expr)
(bind:optionally-annotated-binding ...) body:expr ...) (bind:optionally-annotated-binding ...)
body ...) ; body is not always an expression, can be a break-clause
(quasisyntax/loc stx (quasisyntax/loc stx
(for/fold: : return-annotation (for/fold: : return-annotation
((return-hash : return-annotation (ann (#,hash-maker null) return-annotation))) ((return-hash : return-annotation (ann (#,hash-maker null) return-annotation)))
@ -957,7 +968,8 @@ This file defines two sorts of primitives. All of them are provided into any mod
(syntax-parse stx (syntax-parse stx
#:literals (:) #:literals (:)
((_ (~seq : return-annotation:expr) ((_ (~seq : return-annotation:expr)
(bind:optionally-annotated-binding ...) body:expr ...) (bind:optionally-annotated-binding ...)
body ...) ; body is not always an expression, can be a break-clause
(quasisyntax/loc stx (quasisyntax/loc stx
(for*/fold: : return-annotation (for*/fold: : return-annotation
((return-hash : return-annotation (ann (#,hash-maker null) return-annotation))) ((return-hash : return-annotation (ann (#,hash-maker null) return-annotation)))