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

fix some strange stxclass strangeness

Browse Source 
svn: r13722

original commit: 26fe69d9a775c4f3af7b094c1eddbee97df2650b
This commit is contained in:
Sam Tobin-Hochstadt 2009-02-18 04:31:28 +00:00
parent 7b85ea3692
commit f2ceefc6a6
2 changed files with 10 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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

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

@ -80,12 +80,12 @@
(provide ex pred acc ...)
(p/c (rename *maker maker *maker-cnt))))]
[intern
(let ([mk (lambda (int) #`(defintern (**maker . flds.fs) maker #,int
#,@(if key?
#'(#:extra-arg key-expr)
#'())))])
(syntax-parse #'flds.fs
[_ #:when #'intern?
(let ([mk (lambda (int)
(if key?
#`(defintern (**maker . flds.fs) maker #,int #:extra-arg key-expr)
#`(defintern (**maker . flds.fs) maker #,int)))])
(syntax-parse #'flds.fs
[_ #:when #'intern?
(mk #'intern?)]
[() (mk #'#f)]
[(f) (mk #'f)]
@ -96,7 +96,7 @@
(list (combiner #'free-vars* #'flds.fs)
(combiner #'free-idxs* #'flds.fs)))])
(quasisyntax/loc stx
(w/c nm ([*maker *maker-cnt])
(w/c nm ([*maker *maker-cnt])
(define (*maker . flds.fs)
(define v (**maker . flds.fs))
(unless-in-table
@ -128,7 +128,6 @@
#:transparent
(pattern i:id
#:with lower-s (string-downcase (symbol->string #'i.datum))
#:when (printf "loc1: ~a~n" #'lower-s)
#:with (fld-names ...) default-flds
#:with key? #'#f
#:with first-letter (string-ref #'lower-s 0))
@ -141,7 +140,6 @@
#:with (fld-names ...) (datum->syntax #f (append (syntax->list default-flds)
(syntax->list #'(key))))
#:with lower-s (string-downcase (symbol->string #'i.datum))
#:when (printf "loc2: ~v~n" (syntax->datum #'lower-s))
#:with key? #'#t
#:with first-letter (string-ref #'lower-s 0)))
(define-syntax-class type-name