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

[honu] allow syntax() form to accept a single term. provide some hash stuff

Browse Source
This commit is contained in:
Jon Rafkind 2012-04-20 01:29:48 -06:00
parent b51ab5802a
commit 9858ec72d2
7 changed files with 42 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -83,6 +83,12 @@
[literal:#%brackets #%brackets]
[literal:#%braces #%braces]
[literal:#%parens #%parens])
(rename-out
[datum->syntax datum_to_syntax]
[syntax->datum syntax_to_datum]
[syntax->list syntax_to_list]
[symbol->string symbol_to_string]
[string-append string_append])
print printf
true false
withSyntax

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

@ -52,9 +52,10 @@
[(out ... ((~literal repeat$) stuff ...) rest ...)
(debug 2 " Found a repeat\n")
(with-syntax ([(out* ...) (map remove-repeats (syntax->list #'(out ...)))]
[(stuff* ...) (map remove-repeats (syntax->list #'(stuff ...)))]
[(rest* ...) (map remove-repeats (syntax->list #'(rest ...)))])
(remove-repeats (datum->syntax input
(syntax->list #'(out* ... stuff ... rest* ...))
(syntax->list #'(out* ... stuff* ... rest* ...))
input input)))]
[(normal ...) (with-syntax ([(normal* ...) (map remove-repeats (syntax->list #'(normal ...)))])
(datum->syntax input
@ -104,7 +105,7 @@
(define parsed-property 'honu-parsed)
(define (parsed-syntax syntax)
(debug "Add parsed syntax property to ~a\n" syntax)
(debug "Add parsed syntax property to ~a\n" (syntax->datum syntax))
(if syntax
(syntax-property syntax parsed-property #t)
syntax))

2
collects/honu/core/private/honu2.rkt
View File

@ -347,7 +347,7 @@
[pattern (~seq name:id honu-equal data:honu-expression)
#:with out #'(name data.result)]
[pattern (~seq (#%parens name:id ellipses) honu-equal data:honu-expression)
#:with out #'((name ellipses) data.result)])
#:with out #'((name (... ...)) data.result)])
(syntax-parse code #:literal-sets (cruft)
#:literals (honu-equal)
[(_ (~seq all:clause (~optional honu-comma)) ...

8
collects/honu/core/private/macro2.rkt
View File

@ -212,6 +212,14 @@
(define-honu-syntax honu-syntax
(lambda (code context)
(syntax-parse code #:literal-sets (cruft)
[(_ (#%parens single) . rest)
(define context #'single)
(define compressed (phase0:compress-dollars #'single))
(values
(with-syntax ([stuff* (datum->syntax context compressed context context)])
(phase1:racket-syntax #'stuff*))
#'rest
#f)]
[(_ (#%parens stuff ...) . rest)
(define context (stx-car #'(stuff ...)))
(define compressed (phase0:compress-dollars #'(stuff ...)))

12
collects/honu/core/private/parse2.rkt
View File

@ -292,8 +292,8 @@
#;
(do-parse #'(parsed ... rest ...)
precedence left current)
(debug "Remove repeats from ~a\n" #'parsed)
(define re-parse #'parsed
;; (debug "Remove repeats from ~a\n" #'parsed)
(define re-parse (remove-repeats #'parsed)
#;
(with-syntax ([(x ...) #'parsed])
(debug "Properties on parsed ~a\n" (syntax-property-symbol-keys #'parsed))
@ -325,7 +325,7 @@
(define (do-parse stream precedence left current)
(define-syntax-class atom
;; [pattern x:identifier #:when (not (stopper? #'x))]
[pattern x:identifier]
[pattern x:identifier #:when (not (free-identifier=? #'#%braces #'x))]
[pattern x:str]
[pattern x:number])
@ -444,6 +444,10 @@
[(semicolon . rest)
(debug "Parsed a semicolon, finishing up with ~a\n" current)
(values (left current) #'rest)]
[body:honu-body
(if current
(values (left current) stream)
(do-parse #'(rest ...) precedence left #'body.result))]
#;
[((semicolon more ...) . rest)
#;
@ -659,7 +663,7 @@
(provide identifier-comma-list)
(define-splicing-syntax-class identifier-comma-list
#:literal-sets (cruft)
[pattern (~seq (~seq name:id (~optional honu-comma)) ...)])
[pattern (~seq (~seq name:id (~optional honu-comma) ...) ...)])
(provide honu-expression/comma)
(define-splicing-syntax-class honu-expression/comma

4
collects/honu/core/private/struct.rkt
View File

@ -18,11 +18,11 @@
(define-for-syntax (make-accessors name fields)
(for/list ([field fields])
(format-unique-id field "~a-~a" name field)))
(format-unique-id name "~a-~a" name field)))
(define-for-syntax (make-mutators name fields)
(for/list ([field fields])
(format-unique-id field "set-~a-~a!" name field)))
(format-unique-id name "set-~a-~a!" name field)))
(provide honu-struct-set!)
(define (honu-struct-set! instance name value)

25
collects/honu/main.rkt
View File

@ -27,18 +27,21 @@
integer
cos sin
random
hash
filter
append
values
regexp
(racket:rename-out [honu-cond cond]
[null empty]
[current-inexact-milliseconds currentMilliseconds]
[string-length string_length]
[string-append string_append]
[current-command-line-arguments commandLineArguments]
[racket:find-files find_files]
[racket:empty? empty?]
[regexp-match regexp_match]
[racket:first first]
[racket:rest rest]))
(racket:rename-out
[honu-cond cond]
[null empty]
[hash-set! hash_update]
[current-inexact-milliseconds currentMilliseconds]
[string-length string_length]
[string-append string_append]
[current-command-line-arguments commandLineArguments]
[racket:find-files find_files]
[racket:empty? empty?]
[regexp-match regexp_match]
[racket:first first]
[racket:rest rest]))