diff --git a/collects/honu/core/private/parse2.rkt b/collects/honu/core/private/parse2.rkt index 246f4a2f39..b95ddc4cc3 100644 --- a/collects/honu/core/private/parse2.rkt +++ b/collects/honu/core/private/parse2.rkt @@ -212,15 +212,6 @@ (do-parse-rest #'(stuff ...) #'do-parse-rest-macro)])) |# -(provide parse-local) -(define-syntax-rule (parse-local code ...) - (let () - (define-syntax (parse-more stx) - (syntax-case stx () - [(_ stuff (... ...)) - (do-parse-rest #'(stuff (... ...)) #'parse-more)])) - (parse-more code ...))) - (provide honu-body) (define-syntax-class honu-body #:literal-sets (cruft) @@ -233,6 +224,16 @@ (do-parse-rest #'(stuff (... ...)) #'parse-more)])) (parse-more code ...)))]) +(provide honu-delayed) +(define-syntax-class honu-delayed + [pattern any #:with result (racket-syntax + (let () + (define-syntax (parse-more stx) + (syntax-case stx () + [(_ stuff (... ...)) + (do-parse-rest #'(stuff (... ...)) #'parse-more)])) + (parse-more any)))]) + (provide honu-function) (define-splicing-syntax-class honu-function #:literal-sets (cruft) [pattern (~seq function:identifier (#%parens args ...) body:honu-body) diff --git a/collects/honu/syntax-parse.rkt b/collects/honu/syntax-parse.rkt new file mode 100644 index 0000000000..e04feaedeb --- /dev/null +++ b/collects/honu/syntax-parse.rkt @@ -0,0 +1,26 @@ +#lang racket/base + +(require honu/core/private/syntax + honu/core/private/parse2 + (for-syntax honu/core/private/parse2) + honu/core/private/literals + (for-syntax honu/core/private/compile) + (for-syntax racket/base) + (for-syntax (prefix-in parse: syntax/parse)) + (prefix-in parse: syntax/parse)) + +(define-honu-syntax syntax-parse + (lambda (code context) + + (parse:define-splicing-syntax-class a-pattern #:literals (cruft) + [parse:pattern (parse:~seq var:parse:id %colon class:parse:id) + #:with pattern #'(parse:~var var class)]) + + (parse:syntax-parse code #:literals (cruft) + [(_ data:honu-expression (#%braces (#%brackets something:a-pattern action:honu-delayed) ...) . rest) + (define output + (racket-syntax (parse:syntax-parse data.result + [(something.pattern) action.result] ...))) + (values output #'rest #t)]))) + +(provide syntax-parse)