bnf.rkt (4128B)
1 #lang racket 2 3 (require scribble/decode 4 (except-in scribble/struct 5 element?) 6 (only-in scribble/core 7 content? 8 element? 9 make-style 10 make-table-columns) 11 ) 12 13 (provide (contract-out 14 [BNF (-> (cons/c (or/c block? content?) 15 (non-empty-listof (or/c block? content?))) 16 ... 17 table?)] 18 [BNF-etc element?] 19 ;; operate on content 20 [BNF-seq (-> content? ... 21 (or/c element? ""))] 22 [BNF-seq-lines (-> (listof content?) ... 23 block?)] 24 [BNF-alt (-> content? ... 25 element?)] 26 [BNF-alt/close (-> content? ... 27 element?)] 28 ;; operate on pre-content 29 [BNF-group (-> pre-content? ... 30 element?)] 31 [nonterm (-> pre-content? ... 32 element?)] 33 [optional (-> pre-content? ... 34 element?)] 35 [kleenestar (-> pre-content? ... 36 element?)] 37 [kleeneplus (-> pre-content? ... 38 element?)] 39 [kleenerange (-> any/c any/c pre-content? ... 40 element?)] 41 )) 42 43 44 (define spacer (make-element 'hspace (list " "))) 45 (define equals (make-element 'tt (list spacer "::=" spacer))) 46 (define alt (make-element 'tt (list spacer spacer "|" spacer spacer))) 47 48 (define (as-flow i) (make-flow (list (if (block? i) 49 i 50 (make-paragraph (list i)))))) 51 52 53 (define baseline (make-style #f '(baseline))) 54 55 (define (BNF . defns) 56 (make-table 57 (make-style #f 58 (list 59 (make-table-columns 60 (list baseline baseline baseline baseline)))) 61 (apply 62 append 63 (map (match-lambda 64 [(cons lhs (cons rhs0 more-rhs)) 65 (cons 66 (list (as-flow spacer) (as-flow lhs) (as-flow equals) (as-flow rhs0)) 67 (map (lambda (i) 68 (list (as-flow spacer) (as-flow " ") (as-flow alt) (as-flow i))) 69 more-rhs))]) 70 defns)))) 71 72 ;; interleave : (listof content?) element? -> element? 73 (define (interleave l spacer) 74 (make-element #f (cons (car l) 75 (apply append 76 (map (lambda (i) 77 (list spacer i)) 78 (cdr l)))))) 79 80 (define (BNF-seq . l) 81 (if (null? l) 82 "" 83 (interleave l spacer))) 84 85 (define (BNF-seq-lines . l) 86 (make-table #f (map (lambda (row) (list (as-flow (apply BNF-seq row)))) 87 l))) 88 89 (define (BNF-alt . l) 90 (interleave l alt)) 91 92 (define (BNF-alt/close . l) 93 (interleave l (make-element 'roman " | "))) 94 95 (define BNF-etc (make-element 'roman "...")) 96 97 (define (nonterm . s) 98 (make-element 'roman (append (list 'lang) 99 (list (make-element 'italic (decode-content s))) 100 (list 'rang)))) 101 102 (define (optional . s) 103 (make-element #f (append (list (make-element 'roman "[")) 104 (decode-content s) 105 (list (make-element 'roman "]"))))) 106 107 (define (BNF-group . s) 108 (make-element #f (append (list (make-element 'roman "{")) 109 (list (apply BNF-seq (decode-content s))) 110 (list (make-element 'roman "}"))))) 111 112 (define (kleenestar . s) 113 (make-element #f (append (decode-content s) (list (make-element 'roman "*"))))) 114 115 (define (kleeneplus . s) 116 (make-element #f (append (decode-content s) (list (make-element 'superscript (list "+")))))) 117 118 (define (kleenerange a b . s) 119 (make-element #f (append (decode-content s) 120 (list (make-element 'roman 121 (make-element 'superscript 122 (list (format "{~a,~a}" a b))))))))