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

Provide :-less versions of all for forms.

Browse Source 
Modify the forms as needed to accept non-annotated
bindings to match the untyped versions. Also fixes
bugs in syntax classes found along the way.

original commit: 37b09521ac3493ed45963aedacf7a263194aec1a
This commit is contained in:
Asumu Takikawa 2014-02-13 17:36:54 -05:00
parent 28cba9af4a
commit 4f2bd7180f
6 changed files with 92 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
pkgs/typed-racket-pkgs/typed-racket-compatibility/typed/scheme/base.rkt
View File

@ -4,7 +4,13 @@
with-handlers default-continuation-prompt-tag
define λ lambda define-struct for for*
let let* let-values letrec letrec-values
let/cc let/ec do))
let/cc let/ec do
for/list for/vector for/hash for/hasheq for/hasheqv
for/and for/or for/sum for/product for/lists
for/first for/last for/fold for*/list for*/lists
for*/vector for*/hash for*/hasheq for*/hasheqv for*/and
for*/or for*/sum for*/product for*/first for*/last
for*/fold))
(basics #%module-begin #%top-interaction))
(require typed-racket/base-env/extra-procs

13
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/annotate-classes.rkt
View File

@ -15,19 +15,22 @@
(pattern [~seq name:id : ty]
#:with ann-name (type-label-property #'name #'ty))
(pattern name:id
#:with ty (type-label-property #'name)
#:when #'ty
#:attr *ty (type-label-property #'name)
#:when (attribute *ty)
#:attr ty (datum->syntax #'name (attribute *ty))
#:with ann-name #'name))
(define-splicing-syntax-class optionally-annotated-name
#:attributes (name ann-name)
#:attributes (name ty ann-name)
#:description "optionally type-annotated identifier"
#:literal-sets (colon)
(pattern n:annotated-name
#:with name #'n.name
#:with ty #'n.ty
#:with ann-name #'n.ann-name)
(pattern n:id
#:with name #'n
#:attr ty #f
#:with ann-name #'n))
(define-splicing-syntax-class (param-annotated-name trans)
@ -99,12 +102,14 @@
(define-syntax-class optionally-annotated-formal
#:description "optionally annotated variable of the form [x : T] or just x"
#:opaque
#:attributes (name ann-name)
#:attributes (name ty ann-name)
(pattern f:annotated-formal
#:with name #'f.name
#:attr ty #'f.ty
#:with ann-name #'f.ann-name)
(pattern f:id
#:with name #'f
#:attr ty #f
#:with ann-name #'f))
(define-syntax-class annotated-formals

15
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/for-clauses.rkt
View File

@ -15,13 +15,12 @@
(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))
(pattern (~and c ((v:optionally-annotated-formal ...) 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)
@ -35,7 +34,7 @@
(define-syntax-class accumulator-binding
#:description "accumumulator binding"
#:attributes (ann-name init ty)
(pattern (:annotated-name init:expr)))
(pattern (:optionally-annotated-name init:expr)))
(define-syntax-class accumulator-bindings
#:description "accumumulator bindings"

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

@ -51,13 +51,39 @@ This file defines two sorts of primitives. All of them are provided into any mod
[-letrec-values letrec-values:]
[-let/cc let/cc:]
[-let/ec let/ec:]
[for: for]
[for/list: for/list]
[for/vector: for/vector]
[for/hash: for/hash]
[for/hasheq: for/hasheq]
[for/hasheqv: for/hasheqv]
[for/and: for/and]
[for/or: for/or]
[for/sum: for/sum]
[for/product: for/product]
[for/lists: for/lists]
[for/first: for/first]
[for/last: for/last]
[for/fold: for/fold]
[for*: for*]
[for*/list: for*/list]
[for*/lists: for*/lists]
[for*/vector: for*/vector]
[for*/hash: for*/hash]
[for*/hasheq: for*/hasheq]
[for*/hasheqv: for*/hasheqv]
[for*/and: for*/and]
[for*/or: for*/or]
[for*/sum: for*/sum]
[for*/product: for*/product]
[for*/first: for*/first]
[for*/last: for*/last]
[for*/fold: for*/fold]
[-do do]
[-do do:]
[with-handlers: with-handlers]
[define-typed-struct/exec define-struct/exec:]
[define-typed-struct/exec define-struct/exec]
[for/annotation for]
[for*/annotation for*]))
[define-typed-struct/exec define-struct/exec]))
(module struct-extraction racket/base
(provide extract-struct-info/checked)
@ -825,9 +851,8 @@ This file defines two sorts of primitives. All of them are provided into any mod
(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-formal ...) 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)
@ -907,7 +932,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
(define-syntax (for/lists: stx)
(syntax-parse stx #:literals (:)
[(_ : ty
((var:optionally-annotated-name) ...)
(var:optionally-annotated-formal ...)
clause:for-clauses
c ...) ; c is not always an expression, can be a break-clause
(type-ascription-property
@ -916,15 +941,20 @@ This file defines two sorts of primitives. All of them are provided into any mod
(clause.expand ... ...)
c ...))
#'ty)]
[(_ ((var:annotated-name) ...)
[(_ (var:optionally-annotated-formal ...)
clause:for-clauses
c ...)
(type-ascription-property
(quasisyntax/loc stx
(for/lists (var.ann-name ...)
(clause.expand ... ...)
c ...))
#'(values var.ty ...))]))
(define all-typed? (andmap values (attribute var.ty)))
(define for-stx
(quasisyntax/loc stx
(for/lists (var.ann-name ...)
(clause.expand ... ...)
c ...)))
(if all-typed?
(type-ascription-property
for-stx
#`(values #,@(attribute var.ty)))
for-stx)]))
(define-syntax (for/fold: stx)
(syntax-parse stx #:literals (:)
[(_ : ty
@ -940,12 +970,17 @@ This file defines two sorts of primitives. All of them are provided into any mod
[(_ accum:accumulator-bindings
clause:for-clauses
c ...)
(type-ascription-property
(quasisyntax/loc stx
(for/fold ((accum.ann-name accum.init) ...)
(clause.expand ... ...)
c ...))
#'(values accum.ty ...))]))
(define all-typed? (andmap values (attribute accum.ty)))
(define for-stx
(quasisyntax/loc stx
(for/fold ((accum.ann-name accum.init) ...)
(clause.expand ... ...)
c ...)))
(if all-typed?
(type-ascription-property
for-stx
#`(values #,@(attribute accum.ty)))
for-stx)]))
(define-syntax (for*: stx)

8
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/with-types.rkt
View File

@ -5,7 +5,13 @@
(except-in racket/base for for* with-handlers lambda λ define
let let* letrec letrec-values let-values
let/cc let/ec do struct define-struct
default-continuation-prompt-tag)
default-continuation-prompt-tag
for/list for/vector for/hash for/hasheq for/hasheqv
for/and for/or for/sum for/product for/lists
for/first for/last for/fold for*/list for*/lists
for*/vector for*/hash for*/hasheq for*/hasheqv for*/and
for*/or for*/sum for*/product for*/first for*/last
for*/fold)
"../base-env/prims.rkt"
(prefix-in c: (combine-in racket/contract/region racket/contract/base)))
"../base-env/extra-procs.rkt" (except-in "../base-env/prims.rkt" with-handlers λ lambda define)

8
pkgs/typed-racket-pkgs/typed-racket-lib/typed/racket/base.rkt
View File

@ -4,7 +4,13 @@
with-handlers default-continuation-prompt-tag
define λ lambda define-struct for for*
let let* let-values letrec letrec-values
let/cc let/ec do struct))
let/cc let/ec do struct
for/list for/vector for/hash for/hasheq for/hasheqv
for/and for/or for/sum for/product for/lists
for/first for/last for/fold for*/list for*/lists
for*/vector for*/hash for*/hasheq for*/hasheqv for*/and
for*/or for*/sum for*/product for*/first for*/last
for*/fold))
(basics #%module-begin #%top-interaction))
(require typed-racket/base-env/extra-procs