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

Reimplement for*/list: in TR so that it works.

Browse Source 
Closes PR 13253.
This commit is contained in:
Eric Dobson 2013-03-24 20:42:53 -07:00
parent b637c24d88
commit eeeceedb8c
2 changed files with 21 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -6,3 +6,9 @@
(define (explode s) (define (explode s)
(for/list ([i s]) i)) (for/list ([i s]) i))
(ann
(for*/list: : (Listof Natural)
((x : Natural (list 1 2 4))
(y : Natural (list 2 3 4)))
(+ x y))
(Listof Natural))

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

@ -896,7 +896,6 @@ This file defines two sorts of primitives. All of them are provided into any mod
(begin (define-syntax name (define-for*-variant #'no-colon-name)) (begin (define-syntax name (define-for*-variant #'no-colon-name))
...))])) ...))]))
(define-for*-variants (define-for*-variants
(for*/list: for*/list)
(for*/and: for*/and) (for*/and: for*/and)
(for*/or: for*/or) (for*/or: for*/or)
(for*/first: for*/first) (for*/first: for*/first)
@ -950,7 +949,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
'type-ascription 'type-ascription
#'(values var.ty ...))])) #'(values var.ty ...))]))
(define-for-syntax (define-for/acc:-variant for*? for/folder: for/folder op initial) (define-for-syntax (define-for/acc:-variant for*? for/folder: for/folder op initial final)
(lambda (stx) (lambda (stx)
(syntax-parse stx #:literals (:) (syntax-parse stx #:literals (:)
[(_ a:optional-standalone-annotation [(_ a:optional-standalone-annotation
@ -958,35 +957,38 @@ This file defines two sorts of primitives. All of them are provided into any mod
c ...) ; c is not always an expression, can be a break-clause c ...) ; c is not always an expression, can be a break-clause
(cond (cond
[(syntax-e #'a.ty) [(syntax-e #'a.ty)
;; ty has to include exact 0 or exact 1 (sum/product respectively), ;; ty has to include exact 0, exact 1, null (sum/product/list respectively),
;; the initial value of the accumulator ;; 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
;; Float result. This is problematic in some cases e.g: ;; Float result. This is problematic in some cases e.g:
;; (for/sum: : Float ([i : Float '(1.1)] #:when (zero? (random 1))) i) ;; (for/sum: : Float ([i : Float '(1.1)] #:when (zero? (random 1))) i)
(quasisyntax/loc stx (quasisyntax/loc stx
(#,final
(#,for/folder: : a.ty ([acc : a.ty #,initial]) (#,for/folder: : a.ty ([acc : a.ty #,initial])
(clause.expand ... ...) (clause.expand ... ...)
(let ([new (let () c ...)]) (let ([new (let () c ...)])
(#,op acc new))))] (#,op acc new)))))]
;; With no annotation, try our luck with the core form. ;; With no annotation, try our luck with the core form.
;; Exact base cases cause problems, thus the additional ;; Exact base cases cause problems, thus the additional
;; annotation on the accumulator above. ;; annotation on the accumulator above.
[for*? ((define-for*-variant for/folder) stx)] [for*? ((define-for*-variant for/folder) stx)]
[else ((define-for-variant for/folder) stx)])]))) [else ((define-for-variant for/folder) stx)])])))
(define-syntax (define-for/acc:-variants stx) (define-syntax (define-for/acc:-variants stx)
(syntax-parse stx (syntax-parse stx
[(_ (name for/folder: for/folder for*? op initial) ...) [(_ (name for/folder: for/folder for*? op initial final) ...)
(quasisyntax/loc stx (quasisyntax/loc stx
(begin (define-syntax name (begin (define-syntax name
(define-for/acc:-variant (define-for/acc:-variant
for*? #'for/folder: #'for/folder #'op #'initial)) for*? #'for/folder: #'for/folder #'op #'initial #'final))
...))])) ...))]))
(define-for/acc:-variants (define-for/acc:-variants
(for/sum: for/fold: for/sum #f + 0) (for/sum: for/fold: for/sum #f + 0 #%expression)
(for*/sum: for*/fold: for*/sum #t + 0) (for*/sum: for*/fold: for*/sum #t + 0 #%expression)
(for/product: for/fold: for/product #f * 1) (for*/list: for*/fold: for*/list #t (lambda (x y) (cons y x)) null reverse)
(for*/product: for*/fold: for*/product #t * 1)) (for/product: for/fold: for/product #f * 1 #%expression)
(for*/product: for*/fold: for*/product #t * 1 #%expression))
(define-for-syntax (define-for/hash:-variant hash-maker) (define-for-syntax (define-for/hash:-variant hash-maker)
(lambda (stx) (lambda (stx)