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

[honu] remove context argument from macro transformers

Browse Source
This commit is contained in:
Jon Rafkind 2012-06-15 15:12:30 -06:00
parent 4c0d605c43
commit 60f1c85207
8 changed files with 28 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -27,7 +27,7 @@
(provide honu-class) (provide honu-class)
(define-honu-syntax honu-class (define-honu-syntax honu-class
(lambda (code context) (lambda (code)
(syntax-parse code #:literal-sets (cruft) (syntax-parse code #:literal-sets (cruft)
;; FIXME: empty parenthesis for constructor arguments should be optional ;; FIXME: empty parenthesis for constructor arguments should be optional
[(_ name (#%parens (~var constructor-argument (separate-ids (literal-syntax-class honu-comma) (literal-syntax-class honu-comma)))) [(_ name (#%parens (~var constructor-argument (separate-ids (literal-syntax-class honu-comma) (literal-syntax-class honu-comma))))
@ -41,7 +41,7 @@
(provide honu-new) (provide honu-new)
(define-honu-syntax honu-new (define-honu-syntax honu-new
(lambda (code context) (lambda (code)
(syntax-parse code #:literal-sets (cruft) (syntax-parse code #:literal-sets (cruft)
[(_ name (#%parens arg:honu-expression/comma) . rest) [(_ name (#%parens arg:honu-expression/comma) . rest)
(define new (racket-syntax (make-object name (let () arg.result) ...))) (define new (racket-syntax (make-object name (let () arg.result) ...)))

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

@ -45,7 +45,7 @@
(provide honu-function) (provide honu-function)
(define-honu-syntax honu-function (define-honu-syntax honu-function
(lambda (code context) (lambda (code)
(syntax-parse code #:literal-sets (cruft) (syntax-parse code #:literal-sets (cruft)
[(_ name:identifier (#%parens (~seq arg:identifier (~optional honu-comma)) ...) [(_ name:identifier (#%parens (~seq arg:identifier (~optional honu-comma)) ...)
(#%braces code ...) . rest) (#%braces code ...) . rest)
@ -64,7 +64,7 @@
(provide honu-if) (provide honu-if)
(define-honu-syntax honu-if (define-honu-syntax honu-if
(lambda (code context) (lambda (code)
(syntax-parse code #:literal-sets (cruft) (syntax-parse code #:literal-sets (cruft)
#:literals (else honu-then) #:literals (else honu-then)
[(_ (#%parens condition:honu-expression) true:honu-expression [(_ (#%parens condition:honu-expression) true:honu-expression
@ -76,7 +76,7 @@
(provide honu-val) (provide honu-val)
(define-honu-syntax honu-val (define-honu-syntax honu-val
(lambda (code context) (lambda (code)
(syntax-parse code (syntax-parse code
[(_ rest ...) [(_ rest ...)
(define-values (parsed unparsed) (define-values (parsed unparsed)
@ -85,14 +85,14 @@
(provide honu-quote) (provide honu-quote)
(define-honu-syntax honu-quote (define-honu-syntax honu-quote
(lambda (code context) (lambda (code)
(syntax-parse code (syntax-parse code
[(_ expression rest ...) [(_ expression rest ...)
(values (racket-syntax (quote expression)) #'(rest ...) #f)]))) (values (racket-syntax (quote expression)) #'(rest ...) #f)])))
(provide honu-quasiquote) (provide honu-quasiquote)
(define-honu-syntax honu-quasiquote (define-honu-syntax honu-quasiquote
(lambda (code context) (lambda (code)
(syntax-parse code (syntax-parse code
[(_ expression rest ...) [(_ expression rest ...)
(values (racket-syntax (quasiquote expression)) (values (racket-syntax (quasiquote expression))
@ -137,7 +137,7 @@
(provide define-make-honu-operator) (provide define-make-honu-operator)
(define-honu-syntax define-make-honu-operator (define-honu-syntax define-make-honu-operator
(lambda (code context) (lambda (code)
(syntax-parse code (syntax-parse code
[(_ name:id level:number association:honu-expression function:honu-expression/phase+1 . rest) [(_ name:id level:number association:honu-expression function:honu-expression/phase+1 . rest)
(debug "Operator function ~a\n" (syntax->datum #'function.result)) (debug "Operator function ~a\n" (syntax->datum #'function.result))
@ -274,7 +274,7 @@
(provide honu-require) (provide honu-require)
(define-honu-syntax honu-require (define-honu-syntax honu-require
(lambda (code context) (lambda (code)
(syntax-parse code (syntax-parse code
[(_ form1:require-form form:require-form ... . rest) [(_ form1:require-form form:require-form ... . rest)
(values (values
@ -289,7 +289,7 @@
(provide honu-provide) (provide honu-provide)
(define-honu-syntax honu-provide (define-honu-syntax honu-provide
(lambda (code context) (lambda (code)
(syntax-parse code #:literal-sets (cruft) (syntax-parse code #:literal-sets (cruft)
[(_ name:honu-identifier ... (~optional semicolon) . rest) [(_ name:honu-identifier ... (~optional semicolon) . rest)
(debug "Provide matched names ~a\n" (syntax->datum #'(name.result ...))) (debug "Provide matched names ~a\n" (syntax->datum #'(name.result ...)))
@ -300,7 +300,7 @@
(provide honu-with-input-from-file) (provide honu-with-input-from-file)
(define-honu-syntax honu-with-input-from-file (define-honu-syntax honu-with-input-from-file
(lambda (code context) (lambda (code)
(syntax-parse code #:literal-sets (cruft) (syntax-parse code #:literal-sets (cruft)
[(_ file:honu-expression something:honu-expression . rest) [(_ file:honu-expression something:honu-expression . rest)
(define with (racket-syntax (with-input-from-file file.result (define with (racket-syntax (with-input-from-file file.result
@ -312,7 +312,7 @@
(provide honu-while) (provide honu-while)
(define-honu-syntax honu-while (define-honu-syntax honu-while
(lambda (code context) (lambda (code)
(syntax-parse code #:literal-sets (cruft) (syntax-parse code #:literal-sets (cruft)
[(_ condition:honu-expression body:honu-body . rest) [(_ condition:honu-expression body:honu-body . rest)
(values (values
@ -325,7 +325,7 @@
(provide honu-with honu-match) (provide honu-with honu-match)
(define-literal honu-with) (define-literal honu-with)
(define-honu-syntax honu-match (define-honu-syntax honu-match
(lambda (code context) (lambda (code)
(define-splicing-syntax-class match-clause (define-splicing-syntax-class match-clause
#:literal-sets (cruft) #:literal-sets (cruft)
#:literals (else) #:literals (else)
@ -392,7 +392,7 @@
(provide honu-var) (provide honu-var)
(define-honu-syntax honu-var (define-honu-syntax honu-var
(lambda (code context) (lambda (code)
(syntax-parse code #:literal-sets (cruft) (syntax-parse code #:literal-sets (cruft)
[(var:honu-declaration . rest) [(var:honu-declaration . rest)
(define result (define result
@ -402,7 +402,7 @@
(provide (rename-out [honu-with-syntax withSyntax])) (provide (rename-out [honu-with-syntax withSyntax]))
(define-honu-syntax honu-with-syntax (define-honu-syntax honu-with-syntax
(lambda (code context) (lambda (code)
(define-splicing-syntax-class clause (define-splicing-syntax-class clause
#:literal-sets (cruft) #:literal-sets (cruft)
#:literals [(ellipses ...) honu-equal] #:literals [(ellipses ...) honu-equal]
@ -425,7 +425,7 @@
(provide honu-for) (provide honu-for)
(define-honu-syntax honu-for (define-honu-syntax honu-for
(lambda (code context) (lambda (code)
(syntax-parse code #:literal-sets (cruft) (syntax-parse code #:literal-sets (cruft)
#:literals (honu-in) #:literals (honu-in)
[(_ (~seq iterator:id honu-in stuff:honu-expression (~optional honu-comma)) ... [(_ (~seq iterator:id honu-in stuff:honu-expression (~optional honu-comma)) ...
@ -437,7 +437,7 @@
(provide honu-fold) (provide honu-fold)
(define-honu-syntax honu-fold (define-honu-syntax honu-fold
(lambda (code context) (lambda (code)
(define-splicing-syntax-class sequence-expression (define-splicing-syntax-class sequence-expression
#:literals (honu-in honu-in-lines) #:literals (honu-in honu-in-lines)
[pattern (~seq iterator:id honu-in stuff:honu-expression) [pattern (~seq iterator:id honu-in stuff:honu-expression)

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

@ -170,7 +170,7 @@
(define output (define output
(syntax (quote-syntax (syntax (quote-syntax
(lambda (stx context-name) (lambda (stx)
(define-literal-set local-literals (literal ...)) (define-literal-set local-literals (literal ...))
(syntax-parse stx (syntax-parse stx
#:literal-sets ([cruft #:at name] #:literal-sets ([cruft #:at name]
@ -193,7 +193,7 @@
(provide honu-macro) (provide honu-macro)
(define-honu-syntax honu-macro (define-honu-syntax honu-macro
(lambda (code context) (lambda (code)
(syntax-parse code #:literal-sets (cruft) (syntax-parse code #:literal-sets (cruft)
[(_ name [(_ name
(#%parens literal ...) (#%parens literal ...)
@ -238,7 +238,7 @@
(provide honu-syntax) (provide honu-syntax)
;; Do any honu-specific expansion here ;; Do any honu-specific expansion here
(define-honu-syntax honu-syntax (define-honu-syntax honu-syntax
(lambda (code context) (lambda (code)
(syntax-parse code #:literal-sets (cruft) (syntax-parse code #:literal-sets (cruft)
#; #;
[(_ (#%parens single) . rest) [(_ (#%parens single) . rest)
@ -426,7 +426,7 @@
;; generates a phase 1 binding for the pattern. analyzes its pattern so it ;; generates a phase 1 binding for the pattern. analyzes its pattern so it
;; must execute in phase 2 ;; must execute in phase 2
(define-honu-syntax honu-pattern (define-honu-syntax honu-pattern
(lambda (code context) (lambda (code)
(syntax-parse code #:literal-sets (cruft) (syntax-parse code #:literal-sets (cruft)
[(_ name (#%parens literal ...) [(_ name (#%parens literal ...)
(#%braces pattern ...) (#%braces pattern ...)

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

@ -296,8 +296,7 @@
[(rest ...) rest]) [(rest ...) rest])
(datum->syntax #'head (datum->syntax #'head
(syntax->list #'(head rest ...)) (syntax->list #'(head rest ...))
#'head #'head)) #'head #'head)))])
#f)])
#; #;
(emit-remark parsed) (emit-remark parsed)
#; #;

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

@ -31,7 +31,7 @@
(provide honu-structure) (provide honu-structure)
(define-honu-syntax honu-structure (define-honu-syntax honu-structure
(lambda (code context) (lambda (code)
(syntax-parse code #:literal-sets (cruft) (syntax-parse code #:literal-sets (cruft)
[(_ name:id (#%braces fields:identifier-comma-list) . rest) [(_ name:id (#%braces fields:identifier-comma-list) . rest)
(define out (define out

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

@ -17,10 +17,10 @@
(define (make-honu-transformer proc) (define (make-honu-transformer proc)
(unless (and (procedure? proc) (unless (and (procedure? proc)
(procedure-arity-includes? proc 2)) (procedure-arity-includes? proc 1))
(raise-type-error (raise-type-error
'define-honu-syntax 'define-honu-syntax
"procedure (arity 2)" "procedure (arity 1)"
proc)) proc))
(make-honu-trans proc)) (make-honu-trans proc))

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

@ -19,7 +19,7 @@
(provide honu-cond) (provide honu-cond)
(define-honu-syntax honu-cond (define-honu-syntax honu-cond
(lambda (code context) (lambda (code)
(syntax-parse code #:literal-sets (cruft) (syntax-parse code #:literal-sets (cruft)
[(_ (~seq clause:honu-expression colon body:honu-expression (~optional honu-comma)) ... [(_ (~seq clause:honu-expression colon body:honu-expression (~optional honu-comma)) ...
. rest) . rest)

4
collects/honu/syntax-parse.rkt
View File

@ -10,11 +10,11 @@
(prefix-in parse: syntax/parse)) (prefix-in parse: syntax/parse))
(define-honu-syntax syntax-parse (define-honu-syntax syntax-parse
(lambda (code context) (lambda (code)
(parse:define-splicing-syntax-class a-pattern #:literals (cruft) (parse:define-splicing-syntax-class a-pattern #:literals (cruft)
[parse:pattern (parse:~seq var:parse:id %colon class:parse:id) [parse:pattern (parse:~seq var:parse:id %colon class:parse:id)
#:with pattern #'(parse:~var var class)]) #:with pattern #'(parse:~var var class #:attr-name-separator "_")])
(parse:syntax-parse code #:literals (cruft) (parse:syntax-parse code #:literals (cruft)
[(_ data:honu-expression (#%braces (#%brackets something:a-pattern action:honu-delayed) ...) . rest) [(_ data:honu-expression (#%braces (#%brackets something:a-pattern action:honu-delayed) ...) . rest)