diff --git a/collects/honu/core/main.rkt b/collects/honu/core/main.rkt index 8afce84c5f..5049699ec7 100644 --- a/collects/honu/core/main.rkt +++ b/collects/honu/core/main.rkt @@ -33,6 +33,7 @@ [honu-new new] [honu-while while] [honu-macro macro] + [honu-primitive-macro primitive_macro] [honu-pattern pattern] [racket:read-line readLine] [honu-with-input-from-file withInputFromFile] diff --git a/collects/honu/core/private/compile.rkt b/collects/honu/core/private/compile.rkt index 8a02d3ce13..b3ae1d1fd9 100644 --- a/collects/honu/core/private/compile.rkt +++ b/collects/honu/core/private/compile.rkt @@ -111,7 +111,9 @@ syntax)) (define (parsed-syntax? syntax) - (syntax-property syntax parsed-property)) + (if syntax + (syntax-property syntax parsed-property) + syntax)) (define-syntax (racket-syntax stx) (syntax-case stx () diff --git a/collects/honu/core/private/honu2.rkt b/collects/honu/core/private/honu2.rkt index 4e16c72bcd..27d3a71fff 100644 --- a/collects/honu/core/private/honu2.rkt +++ b/collects/honu/core/private/honu2.rkt @@ -41,7 +41,7 @@ (define-syntax (parse-body stx) (syntax-parse stx [(_ stuff ...) - (honu->racket (parse-all #'(stuff ...)))])) + (parse-all #'(stuff ...))])) (provide honu-function) (define-honu-syntax honu-function @@ -269,9 +269,6 @@ #'name) #:when (not ((literal-set->predicate cruft) #'x))])) -(define-for-syntax (racket-names->honu name) - (regexp-replace* #rx"-" "_")) - (provide honu-require) (define-honu-syntax honu-require (lambda (code) @@ -456,3 +453,14 @@ body.result)) #'rest #t)]))) + +(provide honu-primitive-macro) +(define-honu-syntax honu-primitive-macro + (lambda (code) + (syntax-parse code + [(_ name:id transformer:honu-expression/phase+1 . rest) + (values + (racket-syntax (define-honu-syntax name transformer.result)) + #'rest + #t)]))) + diff --git a/collects/honu/core/private/parse2.rkt b/collects/honu/core/private/parse2.rkt index 1575c309b9..f699b2167d 100644 --- a/collects/honu/core/private/parse2.rkt +++ b/collects/honu/core/private/parse2.rkt @@ -347,13 +347,14 @@ (debug "parse ~a precedence ~a left ~a current ~a properties ~a\n" (syntax->datum stream) precedence left current (syntax-property-symbol-keys stream)) - (define final (if current current #f)) + (define final (if current current #'(void))) (if (parsed-syntax? stream) (values (left stream) #'()) (syntax-parse stream #:literal-sets (cruft) #; [x:id (values #'x #'())] [() + (debug "Empty input out: left ~a ~a\n" left (left final)) (values (left final) #'())] ;; dont reparse pure racket code [(%racket racket)