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

stxclass: added and- and or-patterns, box and vector patterns

Browse Source 
svn: r13721

original commit: 59727cc4bcdb2f4955f3f5206207a8d482736d0a
This commit is contained in:
Ryan Culpepper 2009-02-18 04:01:52 +00:00
parent 3860454c7b
commit 91f75661c4
5 changed files with 11 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/typed-scheme/private/parse-type.ss
View File

@ -251,7 +251,7 @@
(pattern (case-lambda f:fun-ty/one ...)
#:with t (make-Function (syntax->datum #'(f.arr ...))))
(pattern (t:Class (pos-args:type ...) ([fname:id fty:type ((rest:boolean) #:opt) ...*] ...) ([mname:id mty:type] ...))
(pattern (t:Class (pos-args:type ...) ([fname:id fty:type (~or (rest:boolean) #:opt) ...] ...) ([mname:id mty:type] ...))
#:with t
(make-Class
(syntax->datum #'(pos-args.t ...))

4
collects/typed-scheme/private/prims.ss
View File

@ -66,7 +66,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
(syntax-parse stx
[(_ lib [nm:opt-rename ty] ...)
#'(begin (require/typed nm ty lib) ...)]
[(_ nm:opt-rename ty lib ([#:struct-maker parent] #:opt) ...*)
[(_ nm:opt-rename ty lib (~or [#:struct-maker parent] #:opt) ...)
(with-syntax ([cnt* (generate-temporary #'nm.nm)]
[sm (if #'parent
#'(#:struct-maker parent)
@ -87,7 +87,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
(define-syntax-class name-exists-kw
(pattern #:name-exists))
(syntax-parse stx
[(_ ty:id pred:id lib ([ne:name-exists-kw] #:opt) ...*)
[(_ ty:id pred:id lib (~or [ne:name-exists-kw] #:opt) ...)
(register-type-name #'ty (make-Opaque #'pred (syntax-local-certifier)))
(quasisyntax/loc stx
(begin

2
collects/typed-scheme/private/type-abbrev.ss
View File

@ -82,7 +82,7 @@
(define-syntax (->key stx)
(syntax-parse stx
[(_ ty:expr ... ((k:keyword kty:expr opt:boolean)) ...* rng)
[(_ ty:expr ... (~or (k:keyword kty:expr opt:boolean)) ... rng)
#'(make-Function
(list
(make-arr* (list ty ...)

4
collects/typed-scheme/rep/interning.ss
View File

@ -7,9 +7,9 @@
(define-syntax (defintern stx)
(syntax-parse stx
[(_ name+args make-name key ([#:extra-arg e:expr]) ...*)
[(_ name+args make-name key (~or [#:extra-arg e:expr]) ...)
#'(defintern name+args (lambda () (make-hash #;'weak)) make-name key #:extra-arg e ...)]
[(_ (*name:id arg:id ...) make-ht make-name key-expr ([#:extra-arg e:expr]) ...*)
[(_ (*name:id arg:id ...) make-ht make-name key-expr (~or [#:extra-arg e:expr]) ...)
#'(define *name
(let ([table (make-ht)])
(lambda (arg ...)

10
collects/typed-scheme/rep/rep-utils.ss
View File

@ -70,11 +70,11 @@
(define (mk par ht-stx)
(lambda (stx)
(syntax-parse stx
[(dform nm:id flds:idlist ([[#:key key-expr:expr]] #:opt
[[#:intern intern?:expr]] #:opt
[[#:frees . frees:frees-pat]] #:opt
[[#:fold-rhs fold-rhs:fold-pat]] #:opt
[no-provide?:no-provide-kw] #:opt) ...*)
[(dform nm:id flds:idlist (~or [[#:key key-expr:expr]] #:opt
[[#:intern intern?:expr]] #:opt
[[#:frees . frees:frees-pat]] #:opt
[[#:fold-rhs fold-rhs:fold-pat]] #:opt
[no-provide?:no-provide-kw] #:opt) ...)
(with-syntax*
([ex (mk-id #'nm #'nm ":")]
[kw-stx (string->keyword (symbol->string #'nm.datum))]