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

fix uses of syntax-parse attributes

Browse Source 
svn: r15984

original commit: ed65dacdcd2c4c2d2cfe2177865598c97903dfd7
This commit is contained in:
Sam Tobin-Hochstadt 2009-09-11 22:49:56 +00:00
parent 391f497ebb
commit 535ec1720f
5 changed files with 19 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -62,7 +62,6 @@
t:Vectorof t:mu t:Rec t:U t:All t:Opaque t:Parameter quote)
[t
#:declare t (3d Type?)
(printf "3d type ~a~n" #'t.datum)
(attribute t.datum)]
[(fst . rst)
#:fail-unless (not (syntax->list #'rst)) #f

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

@ -172,15 +172,15 @@
(define-syntax-class clause
(pattern
(k:keyword #:matcher mtch pats ... e:expr)
#:with kw (attribute k.datum)
#:with val (list #'mtch
#:attr kw (attribute k.datum)
#:attr val (list #'mtch
(syntax/loc this-syntax (pats ...))
(lambda () #'e)
this-syntax))
(pattern
(k:keyword pats ... e:expr)
#:with kw (syntax-e #'k)
#:with val (list (mk-matcher #'kw)
#:attr kw (syntax-e #'k)
#:attr val (list (mk-matcher (attribute kw))
(syntax/loc this-syntax (pats ...))
(lambda () #'e)
this-syntax)))
@ -193,13 +193,13 @@
#:attributes (datum)
(pattern k:keyword
#:fail-unless (memq (attribute k.datum) kws) #f
#:with datum (attribute k.datum)))
#:attr datum (attribute k.datum)))
(define-syntax-class (sized-list kws)
#:description (format "keyword expr pairs matching with keywords in the list ~a" kws)
(pattern ((~or (~seq k e:expr)) ...)
#:declare k (keyword-in kws)
#:fail-unless (equal? (length (attribute k.datum)) (length (remove-duplicates (attribute k.datum)))) #f
#:with mapping (for/hash ([k* (attribute k.datum)]
#:attr mapping (for/hash ([k* (attribute k.datum)]
[e* (attribute e)])
(values k* e*))
))
@ -229,21 +229,21 @@
#:attributes (i lower-s first-letter key? (fld-names 1))
#:transparent
(pattern i:id
#:with lower-s (string-downcase (symbol->string (attribute i.datum)))
#:attr lower-s (string-downcase (symbol->string (attribute i.datum)))
#:with (fld-names ...) default-flds
#:with key? #'#f
#:with first-letter (string-ref #'lower-s 0))
#:attr first-letter (string-ref (attribute lower-s) 0))
(pattern [i:id #:d d-name:id]
#:with (fld-names ...) default-flds
#:with lower-s (string-downcase (symbol->string (attribute i.datum)))
#:attr lower-s (string-downcase (symbol->string (attribute i.datum)))
#:with key? #'#f
#:with first-letter (symbol->string (attribute d-name.datum)))
#:attr first-letter (symbol->string (attribute d-name.datum)))
(pattern [i:id #:key]
#:with (fld-names ...) (datum->syntax #f (append (syntax->list default-flds)
(syntax->list #'(key))))
#:with lower-s (string-downcase (symbol->string (attribute i.datum)))
#:attr lower-s (string-downcase (symbol->string (attribute i.datum)))
#:with key? #'#t
#:with first-letter (string-ref #'lower-s 0)))
#:attr first-letter (string-ref (attribute lower-s) 0)))
(define-syntax-class type-name
#:transparent
#:auto-nested-attributes

4
collects/typed-scheme/typecheck/tc-expr-unit.ss
View File

@ -26,8 +26,8 @@
(define-syntax-class exp
(pattern i
#:fail-unless expected #f
#:with datum (syntax-e #'i)
#:fail-unless (subtype (-val #'datum) expected) #f))
#:attr datum (syntax-e #'i)
#:fail-unless (subtype (-val (attribute datum)) expected) #f))
(syntax-parse v-stx
[i:exp expected]
[i:boolean (-val (syntax-e #'i))]

6
collects/typed-scheme/utils/stxclass-util.ss
View File

@ -24,14 +24,14 @@
(define-syntax-class (3d pred)
(pattern s
#:with datum (syntax-e #'s)
#:fail-unless (pred #'datum) #f))
#:attr datum (syntax-e #'s)
#:fail-unless (pred (attribute datum)) #f))
(define-syntax-rule (define-pred-stxclass name pred)
(define-syntax-class name #:attributes (datum)
(pattern x
#:fail-unless (pred (syntax-e #'x)) #f
#:with datum (syntax-e #'x))))
#:attr datum (syntax-e #'x))))
(define-pred-stxclass atom atom?)
(define-pred-stxclass byte-pregexp byte-pregexp?)

3
collects/typed-scheme/utils/utils.ss
View File

@ -233,7 +233,8 @@ at least theoretically.
(cond [(string? v) v]
[(symbol? v) (symbol->string v)]
[(char? v) (string v)]
[(identifier? v) (symbol->string (syntax-e v))]))
[(identifier? v) (symbol->string (syntax-e v))]
[else (error "not coerceable:" v)]))
(datum->syntax kw (string->symbol (apply string-append (map f args)))))