yacc-ext.rkt (2200B)
1 #lang racket/base 2 (require (for-syntax racket/base) 3 (prefix-in yacc: parser-tools/yacc) 4 (for-syntax racket/pretty)) 5 (provide parser 6 options 7 productions 8 definitions) 9 10 (define-syntax options 11 (lambda (stx) 12 (raise-syntax-error #f "options keyword used out of context" stx))) 13 14 (define-syntax productions 15 (lambda (stx) 16 (raise-syntax-error #f "productions keyword used out of context" stx))) 17 18 (define-syntax definitions 19 (lambda (stx) 20 (raise-syntax-error #f "definitions keyword used out of context" stx))) 21 22 (define-syntax (parser* stx) 23 (syntax-case stx () 24 [(parser form ...) 25 (let ([stop-list (list #'begin #'options #'productions #'definitions)] 26 [forms (syntax->list #'(form ...))]) 27 (define-values (opts prods defs) 28 (let loop ([forms forms] [opts null] [prods null] [defs null]) 29 (if (pair? forms) 30 (let ([eform0 (local-expand (car forms) 'expression stop-list)] 31 [forms (cdr forms)]) 32 (syntax-case eform0 (begin options productions definitions) 33 [(begin subform ...) 34 (loop (append (syntax->list #'(subform ...)) forms) opts prods defs)] 35 [(options subform ...) 36 (loop forms (append (syntax->list #'(subform ...)) opts) prods defs)] 37 [(productions subform ...) 38 (loop forms opts (append (syntax->list #'(subform ...)) prods) defs)] 39 [(definitions subform ...) 40 (loop forms opts prods (append (syntax->list #'(subform ...)) defs))] 41 [else 42 (raise-syntax-error #f "bad parser subform" eform0)])) 43 (values opts prods defs)))) 44 (with-syntax ([(opt ...) opts] 45 [(prod ...) prods] 46 [(def ...) defs]) 47 #'(let () 48 def ... 49 (#%expression (yacc:parser opt ... (grammar prod ...))))))])) 50 51 (define-syntax-rule (parser . content) 52 ;; Ensure that local expansion doesn't add 53 ;; marks due to use of a macro in the enclosing 54 ;; binding scope: 55 (let () 56 (parser* . content)))