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

[honu] parse bodies of macros early. re-parse the output of macros

Browse Source
This commit is contained in:
Jon Rafkind 2011-11-10 15:55:30 -07:00
parent 6b6ca7a7c3
commit 6e3cf95e83
4 changed files with 30 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -3,6 +3,7 @@
(require "private/honu-typed-scheme.rkt"
"private/honu2.rkt"
"private/macro2.rkt"
(for-syntax (only-in "private/macro2.rkt" honu-syntax))
"private/class.rkt"
(for-syntax (only-in "private/parse2.rkt" honu-expression))
(prefix-in literal: "private/literals.rkt"))
@ -10,7 +11,8 @@
(provide #%top
#%datum
print printf true false
(for-syntax (rename-out [honu-expression expression]))
(for-syntax (rename-out [honu-expression expression]
[honu-syntax syntax]))
(rename-out [#%dynamic-honu-module-begin #%module-begin]
[honu-top-interaction #%top-interaction]
[honu-with-input-from-file with_input_from_file]

8
collects/honu/core/private/honu-typed-scheme.rkt
View File

@ -23,7 +23,7 @@
"literals.rkt"
"debug.rkt"
;; (prefix-in honu: "honu.rkt")
(prefix-in honu: "macro2.rkt")
;; (prefix-in honu: "macro2.rkt")
;; "typed-utils.ss"
)
@ -294,6 +294,7 @@ Then, in the pattern above for 'if', 'then' would be bound to the following synt
(syntax/loc stx
(define-syntax id (make-honu-infix-transformer rhs))))))
#;
(honu:define-honu-syntax honu-macro-item
(lambda (stx ctx)
(syntax-parse stx
@ -303,6 +304,7 @@ Then, in the pattern above for 'if', 'then' would be bound to the following synt
(values #'(define-syntax-class name [pattern x])
#'rest)])))
#;
(honu:define-honu-syntax honu-scheme
(lambda (stx ctx)
(syntax-parse stx #:literals (semicolon)
@ -311,6 +313,7 @@ Then, in the pattern above for 'if', 'then' would be bound to the following synt
[else (raise-syntax-error 'scheme "need a semicolon probably" stx)]
)))
#;
(honu:define-honu-syntax honu-keywords
(lambda (stx ctx)
(syntax-parse stx #:literals (semicolon)
@ -390,6 +393,7 @@ Then, in the pattern above for 'if', 'then' would be bound to the following synt
(parse-an-expr #'(expr ...))]
[else (raise-syntax-error 'honu-unparsed-expr "Invalid expression syntax" stx)]))
#;
(honu:define-honu-syntax scheme-syntax
(lambda (body ctx)
(syntax-parse body
@ -400,6 +404,7 @@ Then, in the pattern above for 'if', 'then' would be bound to the following synt
(apply-scheme-syntax #'#'template))
#'rest)])))
#;
(honu:define-honu-syntax honu-provide
(lambda (body ctx)
(syntax-parse body #:literals (semicolon)
@ -463,6 +468,7 @@ Then, in the pattern above for 'if', 'then' would be bound to the following synt
[x #'x]
[() forms]))
(provide honu-unparsed-begin)
(define-syntax (honu-unparsed-begin stx)
(emit-remark "Honu unparsed begin!" stx)
(debug "honu unparsed begin: ~a at phase ~a\n" (syntax->datum stx) (syntax-local-phase-level))

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

@ -9,6 +9,8 @@
"debug.rkt"
racket/base)
"literals.rkt"
#;
(for-syntax "honu-typed-scheme.rkt")
syntax/parse)
(provide define-honu-syntax)
@ -38,13 +40,13 @@
(debug "Pattern is ~a\n" #'(pattern ...))
(values
(with-syntax ([(syntax-parse-pattern ...)
(convert-pattern #'(pattern ...))])
(convert-pattern #'(pattern ...))]
[(code ...) (parse-all #'(action ...))])
#'(%racket (define-honu-syntax name
(lambda (stx context-name)
(syntax-parse stx
[(_ syntax-parse-pattern ... . more)
(define parsed (parse-all #'(action ...)))
(values parsed #'more #t)
(values (code ...) #'more #t)
#;
(values #'(%racket
(let-syntax ([do-parse (lambda (stx)
@ -63,7 +65,7 @@
(syntax-parse code #:literal-sets (cruft)
[(_ [#%brackets name:id data]
(#%braces code ...))
#'(%racket-expression (with-syntax ([name data]) code ...))])))
#'(%racket (with-syntax ([name data]) code ...))])))
#;
(define-syntax (parse-stuff stx)
@ -78,7 +80,7 @@
(syntax-parse code #:literal-sets (cruft)
[(_ (#%parens stuff ...) . rest)
(values
#'(stuff ...)
#'(%racket #'(stuff ...))
#; #'(%racket-expression (parse-stuff stuff ...))
#'rest
#f)])))

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

@ -200,11 +200,16 @@
#;
(do-parse #'(parsed ... rest ...)
precedence left current)
(define re-parse (let-values ([(re-parse re-unparse)
(parse #'parsed)])
(with-syntax ([(re-parse* ...) re-parse]
[(re-unparse* ...) re-unparse])
#'(re-parse* ... re-unparse* ...))))
(if terminate?
(values (left #'parsed)
(values (left re-parse)
#'rest)
(do-parse #'rest precedence
left #'parsed)))))))
left re-parse)))))))
(define (do-parse stream precedence left current)
(define-syntax-class atom
[pattern x:identifier]
@ -219,8 +224,11 @@
[()
(values (left final) #'())]
;; dont reparse pure racket code
[(%racket racket)
(if current
(values (left current) stream)
(values (left stream) #'()))
#;
[(%racket racket rest ...)
(if current
(values (left current) stream)
(values (left #'racket) #'(rest ...)))]
@ -300,7 +308,7 @@
#'rest)]
[else (syntax-parse #'head
#:literal-sets (cruft)
[(%racket rest ...)
[(%racket x)
(if current
(values (left current) stream)
(do-parse #'(rest ...) precedence left #'head))]