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

[honu] many small things: allow with syntax to bind arbitrary patterns. provide time and time-apply. make compress-dollars recurse on sub-expressions. add an implicit pattern variable that consists of the result with an ellipses depth of 1. fix the while form. allow require forms to contain mostly anything and be separated by commas.

Browse Source
This commit is contained in:
Jon Rafkind 2013-01-11 00:40:48 -07:00
parent c3716d5a97
commit 9a9b30c751
9 changed files with 46 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -22,6 +22,7 @@
[racket:else else]
[racket:void void]
[parse:honu-number number]
[parse:honu-string string]
[honu-function function]
[honu-function fun]
[honu-var var]

3
collects/honu/core/private/extra.rkt
View File

@ -4,5 +4,6 @@
(define (do-lookup data slice)
(cond
[(list? data) (list-ref data slice)]
[(string? data) (string-ref data slice)]
[(vector? data) (vector-ref data slice)]
[else (error 'lookup "don't know how to lookup" data)]))
[else (error 'lookup "don't know how to lookup ~a" data)]))

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

@ -276,6 +276,8 @@
[(string? path) path]
[else (error 'combine-paths "what is ~a" path)])))
(format-id name (string-join all "/")))
(define-splicing-syntax-class not-comma
[pattern x #:when (not ((literal-set->predicate cruft) #'x))])
(define-splicing-syntax-class require-form
#:literals (honu-prefix honu-for-syntax)
#:literal-sets (cruft)
@ -284,20 +286,19 @@
[pattern (~seq honu-for-syntax ~! (#%parens module:require-form))
#:with result #'(for-syntax module.result)]
[pattern x:str #:with result #'x]
[pattern (~seq (~seq base:id (~literal honu-/)) ... x:id)
#:with result (with-syntax ([name (combine-paths
(syntax->list #'(base ...))
(fix-module-name #'x))])
(emit-remark "require-form" #'honu-for-syntax #'x)
(debug "Plain path: ~a ~a\n" #'name (free-identifier=? #'honu-for-syntax #'x))
#'name)
#:when (not ((literal-set->predicate cruft) #'x))]))
[pattern (~seq x:not-comma ...)
#:with result (with-syntax ([name
(string->symbol
(apply string-append
(map (compose symbol->string syntax->datum)
(syntax->list #'(x.x ...)))))])
#'name)]))
(provide honu-require)
(define-honu-syntax honu-require
(lambda (code)
(syntax-parse code
[(_ form1:require-form form:require-form ... . rest)
[(_ form1:require-form (~seq honu-comma form:require-form) ... . rest)
(values
(racket-syntax (require (filtered-in (lambda (name)
(regexp-replace* #rx"-"
@ -338,8 +339,9 @@
[(_ condition:honu-expression body:honu-body . rest)
(values
(racket-syntax (let loop ()
body.result
(when condition.result (loop))))
(when condition.result
body.result
(loop))))
#'rest
#t)])))
@ -457,7 +459,9 @@
[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 (... ...)) data.result)])
#:with out #'((name (... ...)) data.result)]
[pattern (~seq (#%parens (#%parens name:id ellipses) ellipses) honu-equal data:honu-expression)
#:with out #'(((name (... ...)) (... ...)) data.result)])
(syntax-parse code #:literal-sets (cruft)
#:literals (honu-equal)
[(_ (~seq all:clause (~optional honu-comma)) ...
@ -516,4 +520,3 @@
(racket-syntax (define-honu-syntax name transformer.result))
#'rest
#t)])))

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

@ -399,12 +399,15 @@
[(#%braces what ...)
#'(what ...)])
])
#'(#:with result (parse-stuff honu-syntax (#%parens out ...))))
;; #'(#:with result (parse-stuff honu-syntax (#%parens out ...)))
#'(#:with result (parse-stuff out ...))
)
#'(#:with result #'()))])
(syntax/loc honu-pattern
[pattern (~seq new-pattern ...)
withs ... ...
result-with ...
#:with (inner (... ...)) #'result
])))
(define pattern-stuff

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

@ -303,6 +303,7 @@
(values (left current) stream)
(begin
(debug "Honu macro at phase ~a: ~a ~a\n" (syntax-local-phase-level) head (syntax-local-value head))
#;
(emit-remark "Input to macro"
(with-syntax ([head head]
[(rest ...) rest])
@ -316,6 +317,7 @@
(datum->syntax #'head
(syntax->list #'(head rest ...))
#'head #'head)))])
#;
(emit-remark "Output from macro" parsed)
#;
(emit-local-step stream parsed #:id #'do-macro)
@ -598,7 +600,7 @@
[else (if (not current)
(error 'what "don't know how to parse ~a" #'head)
(values (left current) stream))]
[else (error 'what "don't know how to parse ~a" #'head)])])])])))
[else (error 'parser "don't know how to parse ~a" #'head)])])])])))
(emit-remark "Honu parse" input)
(define-values (parsed unparsed)
@ -750,6 +752,10 @@
#:literal-sets (cruft)
[pattern x:number #:with result #'x])
(provide honu-string)
(define-splicing-syntax-class honu-string
#:literal-sets (cruft)
[pattern x:str #:with result #'x])
(provide identifier-comma-list)
(define-splicing-syntax-class identifier-comma-list

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

@ -81,8 +81,9 @@
(syntax-parse stx #:literal-sets (local-literals)
[(honu-$ x:not-dollar ... honu-$ rest ...)
(debug 2 "Compressing ~a\n" #'(x.out ...))
(with-syntax ([(rest* ...) (compress-dollars #'(rest ...))])
(datum->syntax stx (syntax->list #'((repeat$ x.out ...) rest* ...))
(with-syntax ([(rest* ...) (compress-dollars #'(rest ...))]
[(x.out* ...) (compress-dollars #'(x.out ...))])
(datum->syntax stx (syntax->list #'((repeat$ x.out* ...) rest* ...))
stx stx))]
[(honu-$ rest ...)
(error 'compress-dollars "unmatched $ ~a" (syntax->datum stx))]

2
collects/honu/main.rkt
View File

@ -35,6 +35,8 @@
error
(racket:rename-out
[honu-cond cond]
[honu-time time]
[time-apply time_apply]
[null empty]
[make-hash mutable_hash]
[hash-set! hash_update]

9
collects/honu/private/common.rkt
View File

@ -29,3 +29,12 @@
...))
#'rest
#t)])))
(provide honu-time)
(define-honu-syntax honu-time
(lambda (code)
(syntax-parse code #:literal-sets (cruft)
[(_ e:honu-expression . rest)
(values (racket-syntax (time e.result))
#'rest
#'t)])))

2
collects/honu/private/with.honu
View File

@ -3,7 +3,7 @@
provide withSyntax;
macro withSyntax () {
[variable:identifier expr:expression] { b ... /* body:statement */ }; } {
[variable expr:expression] { b ... /* body:statement */ }; } {
primitiveWithSyntax [variable_result (datumToSyntax (syntax expr)
expr_result
(syntax expr)