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

[honu] wrap expressions with let so local macro parsers can be defined. replace more usages of %racket with racket-syntax

Browse Source
This commit is contained in:
Jon Rafkind 2012-02-21 16:18:50 -07:00
parent 7379684c5b
commit 4852904035
4 changed files with 34 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -5,6 +5,7 @@
(only-in "operator.rkt" honu-equal)
(only-in "honu2.rkt" honu-declaration separate-ids)
(for-syntax racket/base
"compile.rkt"
"literals.rkt"
"parse2.rkt"
"util.rkt"
@ -15,7 +16,7 @@
(define (replace-with-public method)
(syntax-parse method #:literals (define)
[(define (name args ...) body ...)
#'(define/public (name args ...) body ...)]))
(racket-syntax (define/public (name args ...) body ...))]))
(define-literal-set equals (honu-equal))
(define-splicing-syntax-class honu-class-thing
#:literal-sets (equals)
@ -32,7 +33,7 @@
[(_ name (#%parens (~var constructor-argument (separate-ids (literal-syntax-class honu-comma) (literal-syntax-class honu-comma))))
(#%braces method:honu-class-thing ...) . rest)
(define class
#'(%racket (define name (class* object% ()
(racket-syntax (define name (class* object% ()
(super-new)
(init-field constructor-argument.id ...)
method.result ...))))
@ -43,7 +44,7 @@
(lambda (code context)
(syntax-parse code #:literal-sets (cruft)
[(_ name (#%parens arg:honu-expression/comma) . rest)
(define new #'(%racket (make-object name arg.result ...)))
(define new (racket-syntax (make-object name (let () arg.result) ...)))
(values
new
(local-binding rest)

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

@ -14,8 +14,7 @@
honu-prefix
semicolon
honu-comma
define-literal
%racket)
define-literal)
(for-syntax syntax/parse
syntax/parse/experimental/reflect
syntax/parse/experimental/splicing
@ -49,14 +48,14 @@
[(_ name:identifier (#%parens (~seq arg:identifier (~optional honu-comma)) ...)
(#%braces code ...) . rest)
(values
#'(%racket (define (name arg ...) (parse-body code ...)))
(racket-syntax (define (name arg ...) (parse-body code ...)))
#'rest
#f)]
[(_ (#%parens (~seq arg:identifier (~optional honu-comma)) ...)
(#%braces code ...)
. rest)
(values
#'(%racket (lambda (arg ...)
(racket-syntax (lambda (arg ...)
(parse-body code ...)))
#'rest
#f)])))
@ -69,7 +68,7 @@
[(_ (#%parens condition:honu-expression) true:honu-expression
(~optional else) false:honu-expression . rest)
(values
(racket-syntax (if condition.result true.result false.result))
(racket-syntax (if (let () condition.result) (let () true.result) (let () false.result)))
#'rest
#f)])))
@ -87,14 +86,14 @@
(lambda (code context)
(syntax-parse code
[(_ expression rest ...)
(values #'(%racket (quote expression)) #'(rest ...) #f)])))
(values (racket-syntax (quote expression)) #'(rest ...) #f)])))
(provide honu-quasiquote)
(define-honu-syntax honu-quasiquote
(lambda (code context)
(syntax-parse code
[(_ expression rest ...)
(values #'(%racket (quasiquote expression))
(values (racket-syntax (quasiquote expression))
#'(rest ...)
#f)])))
@ -130,7 +129,7 @@
(debug "Parsed ~a unparsed ~a\n" parsed unparsed)
(list (parsed-things stx unparsed)
(with-syntax ([parsed parsed])
#'(%racket parsed)))))
(racket-syntax parsed)))))
) ;; begin-for-syntax
@ -140,7 +139,7 @@
(syntax-parse code
[(_ name:id level:number association:honu-expression function:honu-expression/phase+1 . rest)
(debug "Operator function ~a\n" (syntax->datum #'function.result))
(define out #'(%racket (define-honu-operator/syntax name level association.result function.result)))
(define out (racket-syntax (define-honu-operator/syntax name level association.result function.result)))
(values out #'rest #t)])))
(provide honu-dot)
@ -152,7 +151,7 @@
#:literals (honu-equal)
[pattern (_ name:identifier honu-equal argument:honu-expression . more)
#:with result (with-syntax ([left left])
#'(%racket
(racket-syntax
(let ([left* left])
(cond
[(honu-struct? left*)
@ -165,7 +164,7 @@
#:literals (honu-equal)
[pattern (_ name:identifier . more)
#:with result (with-syntax ([left left])
#'(%racket
(racket-syntax
(let ([left* left])
(cond
[(honu-struct? left*) (let ([use (honu-struct-get left*)])
@ -184,7 +183,7 @@
(debug "dot left ~a right ~a\n" left right)
(with-syntax ([left left]
[right right])
#'(%racket
(racket-syntax
(let ([left* left])
(cond
[(honu-struct? left*) (let ([use (honu-struct-get left*)])
@ -217,7 +216,7 @@
(syntax-parse code
[(_ form:require-form ... . rest)
(values
#'(%racket (require (filtered-in (lambda (name)
(racket-syntax (require (filtered-in (lambda (name)
(regexp-replace* #rx"-"
(regexp-replace* #rx"->" name "_to_")
"_"))
@ -240,7 +239,7 @@
(lambda (code context)
(syntax-parse code #:literal-sets (cruft)
[(_ file:honu-expression something:honu-expression . rest)
(define with #'(%racket (with-input-from-file file.result
(define with (racket-syntax (with-input-from-file file.result
(lambda () something.result))))
(values
with
@ -253,7 +252,7 @@
(syntax-parse code #:literal-sets (cruft)
[(_ condition:honu-expression body:honu-body . rest)
(values
#'(%racket (let loop ()
(racket-syntax (let loop ()
body.result
(when condition.result (loop))))
#'rest
@ -277,7 +276,7 @@
#:literals (honu-with)
[(_ thing:honu-expression honu-with clause:match-clause ... . rest)
(values
#'(%racket (match thing.result
(racket-syntax (match thing.result
[clause.final clause.code]
...))
#'rest
@ -345,7 +344,7 @@
#:literals (honu-->)
[(_ (~seq name:id honu--> data:honu-expression (~optional honu-comma)) ...
(#%braces code ...) . rest)
(define out #'(%racket (with-syntax ([name data.result] ...)
(define out (racket-syntax (with-syntax ([name data.result] ...)
(parse-body code ...))))
(values out #'rest #t)])))
@ -362,7 +361,7 @@
honu-do body:honu-expression . rest)
(values (with-syntax ([(stuff.result ...) (map honu->racket (syntax->list #'(stuff.result ...)))]
[body.result (honu->racket #'body.result)])
#'(%racket (for ([iterator stuff.result] ...)
(racket-syntax (for ([iterator stuff.result] ...)
body.result)))
#'rest
#t)])))
@ -383,7 +382,7 @@
[(_ (~seq init:id honu-equal init-expression:honu-expression (~optional honu-comma)) ...
(~seq sequence:sequence-expression (~optional honu-comma)) ...
honu-do body:honu-expression . rest)
(values #'(%racket (for/fold ([init init-expression.result] ...)
(values (racket-syntax (for/fold ([init init-expression.result] ...)
([sequence.variable sequence.expression] ...)
body.result))
#'rest

7
collects/honu/core/private/operator.rkt
View File

@ -4,8 +4,7 @@
"transformer.rkt"
"fixture.rkt"
"compile.rkt"
syntax/parse)
(only-in "literals.rkt" %racket))
syntax/parse))
(provide (all-defined-out))
@ -45,14 +44,14 @@
(lambda (left right)
(with-syntax ([left (honu->racket left)]
[right (honu->racket right)])
#'(%racket (right left)))))
(racket-syntax (right left)))))
(begin-for-syntax
(define-syntax-rule (mutator change)
(lambda (left right)
(with-syntax ([left (honu->racket left)]
[right (change left (honu->racket right))])
#'(%racket (set! left right))))))
(racket-syntax (set! left right))))))
;; Traditional assignment operator
(define-honu-operator/syntax honu-equal 0.0001 'left

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

@ -204,10 +204,12 @@
(define-syntax-class honu-body
#:literal-sets (cruft)
[pattern (#%braces code ...)
#:with result #'(let ()
#:with result (racket-syntax (let ()
(define-syntax (parse-more stx)
(do-parse-rest stx #'parse-more))
(parse-more code ...))])
(syntax-case stx ()
[(_ stuff (... ...))
(do-parse-rest #'(stuff (... ...)) #'parse-more)]))
(parse-more code ...)))])
(provide honu-function)
(define-splicing-syntax-class honu-function #:literal-sets (cruft)
@ -215,8 +217,8 @@
#:with result
(with-syntax ([(parsed-arguments ...)
(parse-arguments #'(args ...))])
#'(define (function parsed-arguments ...)
body.result))])
(racket-syntax (define (function parsed-arguments ...)
body.result)))])
;; E = macro
;; | E operator E
@ -495,7 +497,7 @@
(define call (with-syntax ([current (left current)]
[(parsed-args ...)
(parse-comma-expression #'(args ...)) ])
#'(current parsed-args ...)))
#'(current (let () parsed-args) ...)))
(do-parse #'(rest ...) 9000 (lambda (x) x) call))
(let ()
(debug 2 "function call ~a\n" left)
@ -503,7 +505,7 @@
[(parsed-args ...)
(parse-comma-expression #'(args ...)) ])
(debug "Parsed args ~a\n" #'(parsed-args ...))
#'(current parsed-args ...)))
#'(current (let () parsed-args) ...)))
(do-parse #'(rest ...) precedence left call)))
(let ()
(debug "inner expression ~a\n" #'(args ...))