diff --git a/private/syntax/interface.rkt b/private/syntax/interface.rkt index 76fab9c..15bd768 100644 --- a/private/syntax/interface.rkt +++ b/private/syntax/interface.rkt @@ -177,25 +177,21 @@ #,this-syntax #:pass2 name opts prod ...))) #f))] - [((~or host-interface/expression host-interface/definitions) - _ - #:binding _) - (wrong-syntax this-syntax "missing compilation in host interface")] [(host-interface/expression ~! (name:id . sspec) - (~optional (~seq #:binding bspec)) - parse-body ...+) + bdecl:maybe-binding-decl + c:compiler) (values #f #f #'(define-syntax name (expression-macro (generate-host-interface-transformer - name sspec (~? (bspec) ()) (#:simple) parse-body ...))))] + name sspec (~? (bdecl.bspec) ()) (#:simple) c.body ...))))] [(host-interface/definitions ~! (name:id . sspec) - (~optional (~seq #:binding bspec)) - parse-body ...+) + bdecl:maybe-binding-decl + c:compiler) (values #f #f @@ -204,12 +200,12 @@ (wrap-bind-trampoline (wrap-persist (generate-host-interface-transformer - name sspec (~? (bspec) ()) (#:pass1 #:pass2) parse-body ...))))))] + name sspec (~? (bdecl.bspec) ()) (#:pass1 #:pass2) c.body ...))))))] [(host-interface/definition ~! (name:id . sspec) - (~optional (~seq #:binding bspec)) - #:lhs [name-parse-body ...+] - #:rhs [rhs-parse-body ...+]) + bdecl:maybe-binding-decl + #:lhs [lhs-c:compiler] + #:rhs [rhs-c:compiler]) (values #f #f @@ -221,12 +217,12 @@ (wrap-bind-trampoline (wrap-persist (generate-host-interface-transformer/definition-pass1 - sspec (~? (bspec) ()) [name-parse-body ...] pass2-macro))))) + sspec (~? (bdecl.bspec) ()) [lhs-c.body ...] pass2-macro))))) ;; (before this one) (define-syntax pass2-macro (expression-macro (generate-host-interface-transformer - name sspec (~? (bspec) ()) (#:pass2) rhs-parse-body ...)))))]))) + name sspec (~? (bdecl.bspec) ()) (#:pass2) rhs-c.body ...)))))]))) (begin-for-syntax (define (generate-nonterminal-declarations name-stx opts-stx form-names variant-info-stx) diff --git a/private/syntax/syntax-classes.rkt b/private/syntax/syntax-classes.rkt index d3d4e1c..c31f586 100644 --- a/private/syntax/syntax-classes.rkt +++ b/private/syntax/syntax-classes.rkt @@ -47,7 +47,10 @@ extclass-spec nonterminal-options - ) + + compiler + parse-body + maybe-binding-decl) (require racket/string @@ -185,3 +188,14 @@ #:attr space-stx (attribute maybe-space.stx) #:attr space-sym (attribute maybe-space.sym) #:attr ext-classes (if (attribute extensions) (attribute extensions.classes) '()))) + +(define-splicing-syntax-class compiler + #:description "host interface compiler" + (pattern (~seq body:parse-body ...+))) + +(define-syntax-class parse-body + #:description "pattern directive or body" + (pattern _)) + +(define-splicing-syntax-class maybe-binding-decl + (pattern (~optional (~seq #:binding ~! bspec)))) \ No newline at end of file