diff --git a/collects/honu/main.rkt b/collects/honu/main.rkt index faa379c23b..f6291a468d 100644 --- a/collects/honu/main.rkt +++ b/collects/honu/main.rkt @@ -113,6 +113,7 @@ (for-template #%parens #%brackets #%braces) ;; (for-meta 2 (rename-out (honu-syntax syntax))) (rename-out + (syntax real-syntax) (honu-if if) (honu-provide provide) (honu-macro-item macroItem) diff --git a/collects/honu/private/honu-typed-scheme.rkt b/collects/honu/private/honu-typed-scheme.rkt index fd736cb281..f3b7a20268 100644 --- a/collects/honu/private/honu-typed-scheme.rkt +++ b/collects/honu/private/honu-typed-scheme.rkt @@ -15,6 +15,7 @@ "parse.ss" "literals.ss" ) + syntax/parse "literals.ss" ;; "typed-utils.ss" ) @@ -556,6 +557,10 @@ if (foo){ #'(require (for-syntax what)))) #'rest)]))) +#; +(define-splicing-syntax-class unparsed + [pattern (~seq x ...) #:with result #'(honu-unparsed-begin x ...)]) + (define-syntax (honu-unparsed-begin stx) (printf "honu unparsed begin: ~a at phase ~a\n" (syntax->datum stx) (syntax-local-phase-level)) (syntax-case stx () diff --git a/collects/honu/private/macro.rkt b/collects/honu/private/macro.rkt index cdb97b87f1..480a1d2d50 100644 --- a/collects/honu/private/macro.rkt +++ b/collects/honu/private/macro.rkt @@ -503,6 +503,7 @@ (with-syntax ([(real-out (... ...)) #'(code ...)]) (let ([result (honu-unparsed-begin #'(real-out (... ...)))]) (lambda () result))) + (printf "Macro transformer `~a'\n" (syntax->datum #'(code ...))) (let ([result (honu-unparsed-begin code ...)]) (lambda () result)) #'(rrest (... ...)))])))))) diff --git a/collects/honu/private/more.ss b/collects/honu/private/more.ss index 7e8b7d33d3..3e3ec66912 100644 --- a/collects/honu/private/more.ss +++ b/collects/honu/private/more.ss @@ -208,7 +208,8 @@ (with-syntax ([a #'(fix-template #'(honu-unparsed-begin expr ...))]) #'a) - (printf "Making unparsed syntax???\n") + (printf "Making unparsed syntax with `~a'\n" (syntax->datum #'(expr (... ...)))) + #; (with-syntax ([unparsed (make-unparsed #'(expr ...))]) #'(fix-template unparsed)) @@ -232,7 +233,9 @@ #; (with-syntax ([(out ...) (local-expand #'(expr ...) 'expression '())]) #'(honu-unparsed-begin out ...))) - #'rest)])))) + #'rest)] + [else (raise-syntax-error 'maker "you have used this incorrectly")] + )))) (honu-syntax-maker honu-syntax honu-unparsed-begin) (honu-syntax-maker honu-expression-syntax honu-unparsed-expr) diff --git a/collects/honu/private/parse.rkt b/collects/honu/private/parse.rkt index 68d2772a5d..5a81250572 100644 --- a/collects/honu/private/parse.rkt +++ b/collects/honu/private/parse.rkt @@ -496,6 +496,11 @@ [else (raise-syntax-error 'parse-an-expr "cant parse" stx)] )) +(define-syntax (invoke-transformer stx) + (syntax-parse stx + [(_ all ...) + (parse #'(all ...))])) + (define-splicing-syntax-class honu-body:class #:literals (#%braces) [pattern (~seq (#%braces code ...))]) @@ -548,7 +553,14 @@ (parse-block-one/2 #'(stuff ... more ...) context))]) (values out rest2)))) ] - [(get-transformer stx) => (lambda (transformer) + [(get-transformer stx) => + (lambda (transformer) + (values + (with-syntax ([(all ...) stx]) + #'(invoke-transformer all ...)) + #'())) + #; + (lambda (transformer) (define introducer (make-syntax-introducer)) (define introduce introducer) (define unintroduce introducer)