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

Move from type-ascription-property to add-ann.

Browse Source
This commit is contained in:
Eric Dobson 2013-05-27 11:05:37 -07:00
parent 4ac26e919a
commit 7a7809cdfd
1 changed files with 34 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt
View File

@ -415,7 +415,11 @@ This file defines two sorts of primitives. All of them are provided into any mod
(define-syntax (ann stx) (define-syntax (ann stx)
(syntax-parse stx #:literals (:) (syntax-parse stx #:literals (:)
[(_ (~or (~seq arg : ty) (~seq arg ty))) [(_ (~or (~seq arg : ty) (~seq arg ty)))
(type-ascription-property #'arg #'ty)])) (add-ann #'arg #'ty)]))
(define-for-syntax (add-ann expr-stx ty-stx)
(type-ascription-property expr-stx ty-stx))
(define-syntax (inst stx) (define-syntax (inst stx)
(syntax-parse stx #:literals (:) (syntax-parse stx #:literals (:)
@ -842,8 +846,8 @@ This file defines two sorts of primitives. All of them are provided into any mod
[(_ (~optional (~seq : Void)) [(_ (~optional (~seq : Void))
;; c is not always an expression, could be a break-clause ;; c is not always an expression, could be a break-clause
clauses c ...) ; no need to annotate the type, it's always Void clauses c ...) ; no need to annotate the type, it's always Void
(let ((body #`(; break-clause ... (let ((body #'(; break-clause ...
#,@(type-ascription-property #'(c ...) #'Void)))) c ...)))
(let loop ((clauses #'clauses)) (let loop ((clauses #'clauses))
(define-splicing-syntax-class for-clause (define-splicing-syntax-class for-clause
;; single-valued seq-expr ;; single-valued seq-expr
@ -865,14 +869,14 @@ This file defines two sorts of primitives. All of them are provided into any mod
#:with replace-with #'unless)) #:with replace-with #'unless))
(syntax-parse clauses (syntax-parse clauses
[(head:for-clause next:for-clause ... kw:for-kw rest ...) [(head:for-clause next:for-clause ... kw:for-kw rest ...)
(type-ascription-property (add-ann
(quasisyntax/loc stx (quasisyntax/loc stx
(for (for
(head.expand ... next.expand ... ...) (head.expand ... next.expand ... ...)
#,(loop #'(kw rest ...)))) #,(loop #'(kw rest ...))))
#'Void)] #'Void)]
[(head:for-clause ...) ; we reached the end [(head:for-clause ...) ; we reached the end
(type-ascription-property (add-ann
(quasisyntax/loc stx (quasisyntax/loc stx
(for (for
(head.expand ... ...) (head.expand ... ...)
@ -887,10 +891,13 @@ This file defines two sorts of primitives. All of them are provided into any mod
(kw.replace-with guard (kw.replace-with guard
#,(loop #'(rest ...))))])))])) #,(loop #'(rest ...))))])))]))
(define-for-syntax (maybe-annotate-body body ty) (begin-for-syntax
(if ty (define-splicing-syntax-class optional-standalone-annotation*
(type-ascription-property body ty) #:attributes (ty annotate)
body)) (pattern :optional-standalone-annotation
#:attr annotate (λ (stx) (if (attribute ty)
(add-ann stx #'ty)
stx)))))
;; Handling #:when clauses manually, like we do with for: above breaks ;; Handling #:when clauses manually, like we do with for: above breaks
;; the semantics of for/list and co. ;; the semantics of for/list and co.
@ -901,15 +908,15 @@ This file defines two sorts of primitives. All of them are provided into any mod
(define-for-syntax (define-for-variant name) (define-for-syntax (define-for-variant name)
(lambda (stx) (lambda (stx)
(syntax-parse stx #:literals (:) (syntax-parse stx #:literals (:)
[(_ a:optional-standalone-annotation [(_ a:optional-standalone-annotation*
clause:for-clauses clause:for-clauses
c ...) ; c is not always an expression, can be a break-clause c ...) ; c is not always an expression, can be a break-clause
(maybe-annotate-body ((attribute a.annotate)
(quasisyntax/loc stx (quasisyntax/loc stx
(#,name (#,name
(clause.expand ... ...) (clause.expand ... ...)
c ...)) c ...)))])))
(attribute a.ty))])))
(define-syntax (define-for-variants stx) (define-syntax (define-for-variants stx)
(syntax-parse stx (syntax-parse stx
[(_ (name untyped-name) ...) [(_ (name untyped-name) ...)
@ -934,7 +941,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
(var:optionally-annotated-formal ...) (var:optionally-annotated-formal ...)
clause:for-clauses clause:for-clauses
c ...) ; c is not always an expression, can be a break-clause c ...) ; c is not always an expression, can be a break-clause
(type-ascription-property (add-ann
(quasisyntax/loc stx (quasisyntax/loc stx
(for/lists (var.ann-name ...) (for/lists (var.ann-name ...)
(clause.expand ... ...) (clause.expand ... ...)
@ -950,9 +957,9 @@ This file defines two sorts of primitives. All of them are provided into any mod
(clause.expand ... ...) (clause.expand ... ...)
c ...))) c ...)))
(if all-typed? (if all-typed?
(type-ascription-property (add-ann
for-stx for-stx
#`(values #,@(attribute var.ty))) #'(values var.ty ...))
for-stx)])) for-stx)]))
(define-syntax (for/fold: stx) (define-syntax (for/fold: stx)
(syntax-parse stx #:literals (:) (syntax-parse stx #:literals (:)
@ -960,7 +967,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
((var:optionally-annotated-name init:expr) ...) ((var:optionally-annotated-name init:expr) ...)
clause:for-clauses clause:for-clauses
c ...) ; c is not always an expression, can be a break-clause c ...) ; c is not always an expression, can be a break-clause
(type-ascription-property (add-ann
(quasisyntax/loc stx (quasisyntax/loc stx
(for/fold ((var.ann-name init) ...) (for/fold ((var.ann-name init) ...)
(clause.expand ... ...) (clause.expand ... ...)
@ -976,12 +983,11 @@ This file defines two sorts of primitives. All of them are provided into any mod
(clause.expand ... ...) (clause.expand ... ...)
c ...))) c ...)))
(if all-typed? (if all-typed?
(type-ascription-property (add-ann
for-stx for-stx
#`(values #,@(attribute accum.ty))) #'(values accum.ty ...))
for-stx)])) for-stx)]))
(define-syntax (for*: stx) (define-syntax (for*: stx)
(syntax-parse stx #:literals (:) (syntax-parse stx #:literals (:)
[(_ (~seq : Void) ... [(_ (~seq : Void) ...
@ -995,14 +1001,13 @@ This file defines two sorts of primitives. All of them are provided into any mod
(define-for-syntax (define-for*-variant name) (define-for-syntax (define-for*-variant name)
(lambda (stx) (lambda (stx)
(syntax-parse stx #:literals (:) (syntax-parse stx #:literals (:)
[(_ a:optional-standalone-annotation [(_ a:optional-standalone-annotation*
clause:for-clauses clause:for-clauses
c ...) ; c is not always an expression, can be a break-clause c ...) ; c is not always an expression, can be a break-clause
(maybe-annotate-body ((attribute a.annotate)
(quasisyntax/loc stx (quasisyntax/loc stx
(#,name (clause.expand ... ...) (#,name (clause.expand ... ...)
c ...)) c ...)))])))
(attribute a.ty))])))
(define-syntax (define-for*-variants stx) (define-syntax (define-for*-variants stx)
(syntax-parse stx (syntax-parse stx
[(_ (name no-colon-name) ...) [(_ (name no-colon-name) ...)
@ -1023,7 +1028,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
((var:optionally-annotated-name) ...) ((var:optionally-annotated-name) ...)
clause:for-clauses clause:for-clauses
c ...) ; c is not always an expression, can be a break-clause c ...) ; c is not always an expression, can be a break-clause
(type-ascription-property (add-ann
(quasisyntax/loc stx (quasisyntax/loc stx
(for/lists (var.ann-name ...) (for/lists (var.ann-name ...)
(clause.expand* ... ...) (clause.expand* ... ...)
@ -1032,7 +1037,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
[(_ ((var:annotated-name) ...) [(_ ((var:annotated-name) ...)
clause:for-clauses clause:for-clauses
c ...) c ...)
(type-ascription-property (add-ann
(quasisyntax/loc stx (quasisyntax/loc stx
(for/lists (var.ann-name ...) (for/lists (var.ann-name ...)
(clause.expand* ... ...) (clause.expand* ... ...)
@ -1044,7 +1049,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
((var:optionally-annotated-name init:expr) ...) ((var:optionally-annotated-name init:expr) ...)
clause:for-clauses clause:for-clauses
c ...) ; c is not always an expression, can be a break-clause c ...) ; c is not always an expression, can be a break-clause
(type-ascription-property (add-ann
(quasisyntax/loc stx (quasisyntax/loc stx
(for/fold ((var.ann-name init) ...) (for/fold ((var.ann-name init) ...)
(clause.expand* ... ...) (clause.expand* ... ...)
@ -1053,7 +1058,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
[(_ ((var:annotated-name init:expr) ...) [(_ ((var:annotated-name init:expr) ...)
clause:for-clauses clause:for-clauses
c ...) c ...)
(type-ascription-property (add-ann
(quasisyntax/loc stx (quasisyntax/loc stx
(for/fold ((var.ann-name init) ...) (for/fold ((var.ann-name init) ...)
(clause.expand* ... ...) (clause.expand* ... ...)
@ -1063,7 +1068,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
(define-for-syntax (define-for/acc:-variant for*? for/folder: for/folder op initial final) (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*
clause:for-clauses clause:for-clauses
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