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

[honu] replace $ with honu-$ just to be safe

Browse Source
This commit is contained in:
Jon Rafkind 2012-04-19 17:05:30 -06:00
parent 79b6e5611e
commit b51ab5802a
3 changed files with 10 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/honu/core/main.rkt
View File

@ -77,7 +77,7 @@
[literal:honu-in in] [literal:honu-in in]
[literal:semicolon %semicolon] [literal:semicolon %semicolon]
[literal:honu-comma honu-comma] [literal:honu-comma honu-comma]
[literal:honu-$ $] [literal:honu-$ honu-$]
[literal:honu-<- <-] [literal:honu-<- <-]
[literal:honu-in-lines inLines] [literal:honu-in-lines inLines]
[literal:#%brackets #%brackets] [literal:#%brackets #%brackets]

10
collects/honu/core/private/compile.rkt
View File

@ -123,15 +123,19 @@
(define-literal-set local-literals (honu-$ repeat$)) (define-literal-set local-literals (honu-$ repeat$))
(define-splicing-syntax-class not-dollar (define-splicing-syntax-class not-dollar
#:literal-sets (local-literals) #:literal-sets (local-literals)
[pattern x #:when (and (identifier? #'x) [pattern x #:when (or (not (identifier? #'x))
(not (free-identifier=? #'honu-$ #'x))) (not (free-identifier=? #'honu-$ #'x)))
#:with out #'x]) #:with out #'x])
(debug 2 "Compress dollars ~a\n" stx)
(syntax-parse stx #:literal-sets (local-literals) (syntax-parse stx #:literal-sets (local-literals)
[(honu-$ x:not-dollar ... honu-$ rest ...) [(honu-$ x:not-dollar ... honu-$ rest ...)
(debug 2 "Compressing ~a\n" #'(x.out ...))
(with-syntax ([(rest* ...) (compress-dollars #'(rest ...))]) (with-syntax ([(rest* ...) (compress-dollars #'(rest ...))])
(datum->syntax stx (syntax->list #'((repeat$ x.out ...) rest* ...)) (datum->syntax stx (syntax->list #'((repeat$ x.out ...) rest* ...))
stx stx))] stx stx))]
[(x:not-dollar rest ...) [(honu-$ rest ...)
(error 'compress-dollars "unmatched $ ~a" (syntax->datum stx))]
[(x rest ...)
(with-syntax ([x* (compress-dollars #'x)] (with-syntax ([x* (compress-dollars #'x)]
[(rest* ...) (compress-dollars #'(rest ...))]) [(rest* ...) (compress-dollars #'(rest ...))])
(datum->syntax stx (datum->syntax stx

3
collects/honu/core/read.rkt
View File

@ -38,7 +38,7 @@
(define-lex-abbrev string (:: #\" (:* string-character) #\")) (define-lex-abbrev string (:: #\" (:* string-character) #\"))
(define-lex-abbrev operator (:or "+=" "-=" "*=" "/=" (define-lex-abbrev operator (:or "+=" "-=" "*=" "/="
"+" "!=" "=>" "=" "==" "*" "/" "-" "^" "||" "|" "&&" "<=" "+" "!=" "=>" "=" "==" "*" "/" "-" "^" "||" "|" "&&" "<="
">=" "<-" "<" ">" "!" "::" ":=" "%" "$")) ">=" "<-" "<" ">" "!" "::" ":=" "%"))
(define-lex-abbrev block-comment (:: "/*" (define-lex-abbrev block-comment (:: "/*"
(complement (:: any-string "*/" any-string)) (complement (:: any-string "*/" any-string))
"*/")) "*/"))
@ -71,6 +71,7 @@
["/*" (token-block-comment)] ["/*" (token-block-comment)]
["..." (token-identifier '...)] ["..." (token-identifier '...)]
["." (token-identifier '%dot)] ["." (token-identifier '%dot)]
["$" (token-identifier 'honu-$)]
["," (token-identifier 'honu-comma)] ["," (token-identifier 'honu-comma)]
[":" (token-identifier '%colon)] [":" (token-identifier '%colon)]
["'" (token-identifier 'quote)] ["'" (token-identifier 'quote)]