suzanne.soy/typed-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.

original commit: ec673fd58d3e24e999426e4bc07d72a05e3a099b
This commit is contained in:
Vincent St-Amour 2012-12-12 14:19:14 -05:00
parent 9b126624ac
commit 0145f047ff
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)
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))
(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
(define-splicing-syntax-class for*-clause
(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))
#'#:when #'#t))
;; 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 (quasisyntax/loc
#'c
((v.ann-name ...) seq-expr))
#'#:when #'#t))
;; when clause
(pattern (~seq #:when guard:expr)
#:with (expand ...) (list #'#:when #'guard))
(pattern (~seq #:unless guard:expr)
#:with (expand ...) (list #'#:unless #'guard)))
(pattern (~and c (var:optionally-annotated-name seq-expr:expr))
#:with (expand ...) #`(#,(syntax/loc #'c
(var.ann-name seq-expr)))
#:with (expand* ...) #'(expand ... #:when #t))
;; 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)))
;; #:with (expand* ...) (list (quasisyntax/loc #'c
;; ((v.ann-name ...) seq-expr))
;; #'#:when #'#t))
;; Note: #:break and #:final clauses don't ever typecheck
(pattern (~seq (~and kw (~or #:when #:unless #:break #:final)) guard:expr)
#:with (expand ...) (list #'kw #'guard)
#:with (expand* ...) #'(expand ...)))

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
;; for consistency with the other for: macros
[(_ (~seq : Void) ...
clauses ; no need to annotate the type, it's always Void
c:expr ...)
(let ((body (syntax-property #'(c ...) 'type-ascription #'Void)))
;; c is not always an expression, could be a break-clause
clauses c ...) ; no need to annotate the type, it's always Void
(let ((body #`(; break-clause ...
#,@(syntax-property #'(c ...) 'type-ascription #'Void))))
(let loop ((clauses #'clauses))
(define-syntax-class for-clause
(define-splicing-syntax-class for-clause
;; single-valued seq-expr
;; unlike the definitions in for-clauses.rkt, this does not include
;; #:when clauses, which are handled separately here
(pattern (var:optionally-annotated-name seq-expr:expr)
#:with expand #'(var.ann-name seq-expr))
(pattern (~seq (var:optionally-annotated-name seq-expr:expr))
#:with (expand ...) #'((var.ann-name seq-expr)))
;; multi-valued seq-expr
;; currently disabled because it triggers an internal error in the typechecker
#;(pattern ((v:optionally-annotated-name ...) seq-expr:expr)
#:with expand #'((v.ann-name ...) seq-expr)))
;; (pattern ((v:optionally-annotated-name ...) seq-expr: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
[(head:for-clause next:for-clause ... #:when rest ...)
[(head:for-clause next:for-clause ... kw:for-kw rest ...)
(syntax-property
(quasisyntax/loc stx
(for
(head.expand next.expand ...)
#,(loop #'(#:when rest ...))))
(head.expand ... next.expand ... ...)
#,(loop #'(kw rest ...))))
'type-ascription
#'Void)]
[(head:for-clause ...) ; we reached the end
(syntax-property
(quasisyntax/loc stx
(for
(head.expand ...)
(head.expand ... ...)
#,@body))
'type-ascription
#'Void)]
[(#:when guard) ; we end on a #:when clause
[(kw:for-kw guard) ; we end on a keyword clause
(quasisyntax/loc stx
(when guard
(kw.replace-with guard
#,@body))]
[(#:when guard rest ...)
[(kw:for-kw guard rest ...)
(quasisyntax/loc stx
(when guard
(kw.replace-with guard
#,(loop #'(rest ...))))])))]))
(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 (:)
[(_ a:optional-standalone-annotation
(clause:for-clause ...)
c:expr ...)
c ...) ; c is not always an expression, can be a break-clause
(maybe-annotate-body
(quasisyntax/loc stx
(#,name
@ -783,7 +793,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
[(_ : ty
((var:optionally-annotated-name) ...)
(clause:for-clause ...)
c:expr ...)
c ...) ; c is not always an expression, can be a break-clause
(syntax-property
(quasisyntax/loc stx
(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)]
[(_ ((var:annotated-name) ...)
(clause:for-clause ...)
c:expr ...)
c ...)
(syntax-property
(quasisyntax/loc stx
(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
((var:optionally-annotated-name init:expr) ...)
(clause:for-clause ...)
c:expr ...)
c ...) ; c is not always an expression, can be a break-clause
(syntax-property
(quasisyntax/loc stx
(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)]
[(_ ((var:annotated-name init:expr) ...)
(clause:for-clause ...)
c:expr ...)
c ...)
(syntax-property
(quasisyntax/loc stx
(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)
(syntax-parse stx #:literals (:)
[(_ (~seq : Void) ...
(clause:for*-clause ...)
c:expr ...)
(clause:for-clause ...)
c ...) ; c is not always an expression, can be a break-clause
(quasisyntax/loc stx
(for: (clause.expand ... ...)
(for: (clause.expand* ... ...)
c ...))]))
;; 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 (:)
[(_ a:optional-standalone-annotation
(clause:for-clause ...)
c:expr ...)
c ...) ; c is not always an expression, can be a break-clause
(maybe-annotate-body
(quasisyntax/loc stx
(#,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 (:)
[(_ : ty
((var:optionally-annotated-name) ...)
(clause:for*-clause ...)
c:expr ...)
(clause:for-clause ...)
c ...) ; c is not always an expression, can be a break-clause
(syntax-property
(quasisyntax/loc stx
(for/lists (var.ann-name ...)
(clause.expand ... ...)
(clause.expand* ... ...)
c ...))
'type-ascription
#'ty)]
[(_ ((var:annotated-name) ...)
(clause:for*-clause ...)
c:expr ...)
(clause:for-clause ...)
c ...)
(syntax-property
(quasisyntax/loc stx
(for/lists (var.ann-name ...)
(clause.expand ... ...)
(clause.expand* ... ...)
c ...))
'type-ascription
#'(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 (:)
[(_ : ty
((var:optionally-annotated-name init:expr) ...)
(clause:for*-clause ...)
c:expr ...)
(clause:for-clause ...)
c ...) ; c is not always an expression, can be a break-clause
(syntax-property
(quasisyntax/loc stx
(for/fold ((var.ann-name init) ...)
(clause.expand ... ...)
(clause.expand* ... ...)
c ...))
'type-ascription
#'ty)]
[(_ ((var:annotated-name init:expr) ...)
(clause:for*-clause ...)
c:expr ...)
(clause:for-clause ...)
c ...)
(syntax-property
(quasisyntax/loc stx
(for/fold ((var.ann-name init) ...)
(clause.expand ... ...)
(clause.expand* ... ...)
c ...))
'type-ascription
#'(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 (:)
[(_ : ty
(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
;; (to be consistent with Racket semantics).
;; 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
#:literals (:)
((_ (~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
(for/fold: : 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
#:literals (:)
((_ (~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
(for*/fold: : return-annotation
((return-hash : return-annotation (ann (#,hash-maker null) return-annotation)))