Skip to content

Commit 9cbfb25

Browse files
author
Ben Lerner
committed
minor improvements and refactorings to the ebnf infrastructure (copied from my course website infrastructure)
1 parent bc6aca5 commit 9cbfb25

File tree

3 files changed

+100
-66
lines changed

3 files changed

+100
-66
lines changed

‎ebnf.rkt

+89
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,89 @@
1+
#lang at-exp racket/base
2+
3+
(require scribble/base scribble/core scribble/decode scribble/basic scribble/html-properties
4+
racket/list "ragged.rkt" racket/string)
5+
6+
(provide bnf prod-link prod-ref)
7+
8+
(define (prod-tag grammar prod-name) (list 'bnf-prod (list grammar prod-name)))
9+
(define (prod-ref name) (list "‹" name "›"))
10+
(define (prod-link grammar name)
11+
(elemref (prod-tag grammar name) (prod-ref name)))
12+
13+
14+
(define (render grammar parsed)
15+
(define-values (constants prods) (partition constant? parsed))
16+
(define names (map (λ(c) (list (lhs-id-val (constant-lhs c)) (pattern-lit-val (constant-val c)))) constants))
17+
(define (meta s)
18+
(elem s #:style (make-style #f (list (attributes '((class . "bnf-meta")))))))
19+
(define (lit s)
20+
(elem s #:style (make-style #f (list (attributes '((class . "bnf-lit")))))))
21+
(define (eps)
22+
(elem "ε" #:style (make-style #f (list (attributes '((class . "bnf-eps")))))))
23+
(define (unknown-lit s)
24+
(elem s #:style (make-style #f (list (attributes '((class . "bnf-lit bnf-unknown")))))))
25+
(define rule-name (make-parameter #f))
26+
(define (render-help p #:start [start #f])
27+
(cond
28+
[(pattern-seq? p)
29+
(add-between (map render-help (pattern-seq-vals p)) " ")]
30+
[(pattern-maybe? p)
31+
(list (meta "[") (render-help (pattern-maybe-val p)) (meta "]"))]
32+
[(pattern-repeat? p)
33+
(list (meta "(") (render-help (pattern-repeat-val p)) (meta ")")
34+
(if (= 0 (pattern-repeat-min p)) (meta "*") (meta "+")))]
35+
[(pattern-choice? p)
36+
(define choices (pattern-choice-vals p))
37+
(define pat-breaks
38+
(filter (λ(i) i)
39+
(for/list
40+
([c1 choices] [c2 (rest choices)])
41+
(if (> (pos-line (pattern-start c2)) (pos-line (pattern-start c1))) c2 #f))))
42+
(define breaks
43+
(if (> (pos-line (pattern-start (first choices))) (pos-line (pattern-start p)))
44+
(cons (first choices) pat-breaks)
45+
pat-breaks))
46+
(define indent (string-append "\n" (make-string (+ 2 (* 2 (string-length (rule-name)))) #\space)))
47+
(define translated
48+
(map (λ(c)
49+
(list (if (member c breaks) indent "")
50+
(meta " | ")
51+
(render-help c))) choices))
52+
(if (and start (> (pos-line (pattern-start (first choices))) (pos-line start)))
53+
(cons indent (flatten translated))
54+
(drop (flatten translated) 2))]
55+
[(pattern-token? p)
56+
(define tok (assoc (pattern-token-val p) names))
57+
(cond
58+
[tok (lit (second tok))]
59+
[else (unknown-lit (pattern-token-val p))])]
60+
[(pattern-lit? p)
61+
(lit (pattern-lit-val p))]
62+
[(pattern-id? p)
63+
(prod-link grammar (pattern-id-val p))]
64+
[(pattern-epsilon? p)
65+
(eps)]
66+
[else
67+
(printf "Unknown prod: ~a" p)]))
68+
69+
(nested #:style (make-style 'code-inset (list (attributes '((style . "white-space: pre;")))))
70+
(add-between
71+
(for/list [(p prods)]
72+
(parameterize ([rule-name (lhs-id-val (rule-lhs p))])
73+
(list (elemtag (prod-tag grammar (rule-name))
74+
(elem (prod-ref (rule-name))
75+
#:style (make-style #f (list (attributes '((class . "bnf-rule")))))))
76+
(meta ":")
77+
" "
78+
(render-help (rule-pattern p) #:start (rule-start p)))))
79+
"\n")
80+
)
81+
)
82+
83+
(define (bnf grammar . stx)
84+
(define text (string-join stx ""))
85+
(define text-port (open-input-string text))
86+
(port-count-lines! text-port)
87+
(define parsed (grammar-parser (tokenize text-port)))
88+
(render grammar parsed)
89+
)

‎ragged.rkt

+10
Original file line numberDiff line numberDiff line change
@@ -33,6 +33,10 @@
3333
(struct pattern-token pattern (val)
3434
#:transparent)
3535

36+
;; The empty production
37+
(struct pattern-epsilon pattern ()
38+
#:transparent)
39+
3640
;; Token structure defined as the literal string to be matched.
3741
(struct pattern-lit pattern (val)
3842
#:transparent)
@@ -73,6 +77,7 @@
7377
CONSTANT
7478
LIT
7579
EOF
80+
EPS
7681
UNKNOWN))
7782

7883

@@ -98,6 +103,8 @@
98103
(token-PIPE lexeme)]
99104
[(:or "+" "*")
100105
(token-REPEAT lexeme)]
106+
["~eps~"
107+
(token-EPS lexeme)]
101108
[whitespace
102109
;; Skip whitespace
103110
(return-without-pos (lex/1 input-port))]
@@ -234,6 +241,9 @@
234241
$1]]
235242

236243
[atomic-pattern
244+
[(EPS)
245+
(pattern-epsilon (position->pos $1-start-pos)
246+
(position->pos $1-end-pos))]
237247
[(LIT)
238248
(pattern-lit (position->pos $1-start-pos)
239249
(position->pos $1-end-pos)

‎scribble-api.rkt

+1-66
Original file line numberDiff line numberDiff line change
@@ -26,6 +26,7 @@
2626
racket/runtime-path
2727
"scribble-helpers.rkt"
2828
"ragged.rkt"
29+
"ebnf.rkt"
2930
)
3031

3132
(provide bnf
@@ -824,70 +825,4 @@
824825
(set! curr-doc-checks (init-doc-checker ALL-GEN-DOCS))
825826
'())
826827

827-
(define (prod-tag grammar prod-name) (list 'bnf-prod (list grammar prod-name)))
828-
(define (prod-ref name) (list "‹" name "›"))
829-
(define (prod-link grammar name)
830-
(elemref (prod-tag grammar name) (prod-ref name)))
831828
(define (py-prod name) (prod-link 'Pyret name))
832-
833-
(define (render grammar parsed)
834-
(define-values (constants prods) (partition constant? parsed))
835-
(define names (map (λ(c) (list (lhs-id-val (constant-lhs c)) (pattern-lit-val (constant-val c)))) constants))
836-
(define (meta s)
837-
(elem s #:style (make-style #f (list (attributes '((class . "bnf-meta")))))))
838-
(define (lit s)
839-
(elem s #:style (make-style #f (list (attributes '((class . "bnf-lit")))))))
840-
(define (unknown-lit s)
841-
(elem s #:style (make-style #f (list (attributes '((class . "bnf-lit bnf-unknown")))))))
842-
(define rule-name (make-parameter #f))
843-
(define (render-help p)
844-
(cond
845-
[(pattern-seq? p)
846-
(add-between (map render-help (pattern-seq-vals p)) " ")]
847-
[(pattern-maybe? p)
848-
(list (meta "[") (render-help (pattern-maybe-val p)) (meta "]"))]
849-
[(pattern-repeat? p)
850-
(list (meta "(") (render-help (pattern-repeat-val p)) (meta ")")
851-
(if (= 0 (pattern-repeat-min p)) (meta "*") (meta "+")))]
852-
[(pattern-choice? p)
853-
(define choices (pattern-choice-vals p))
854-
(define breaks
855-
(filter (λ(i) i)
856-
(for/list
857-
([c1 choices] [c2 (rest choices)])
858-
(if (> (pos-line (pattern-start c2)) (pos-line (pattern-start c1))) c2 #f))))
859-
(define translated
860-
(map (λ(c)
861-
(list (if (member c breaks)
862-
(string-append "\n" (make-string (* 2 (string-length (rule-name))) #\space))
863-
"")
864-
(meta " | ")
865-
(render-help c))) choices))
866-
(drop (flatten translated) 2)]
867-
[(pattern-token? p)
868-
(define tok (assoc (pattern-token-val p) names))
869-
(cond
870-
[tok (lit (second tok))]
871-
[else (unknown-lit (pattern-token-val p))])]
872-
[(pattern-lit? p)
873-
(lit (pattern-lit-val p))]
874-
[(pattern-id? p)
875-
(prod-link grammar (pattern-id-val p))]
876-
[else
877-
(printf "Unknown prod: ~a" p)]))
878-
879-
(nested #:style (make-style 'code-inset (list (attributes '((style . "white-space: pre;")))))
880-
(add-between (for/list [(p prods)]
881-
(parameterize ([rule-name (lhs-id-val (rule-lhs p))])
882-
(list (elemtag (prod-tag grammar (rule-name)) (prod-ref (rule-name))) (meta ":") " " (render-help (rule-pattern p))))
883-
) "\n")
884-
)
885-
)
886-
887-
(define (bnf grammar . stx)
888-
(define text (string-join stx ""))
889-
(define text-port (open-input-string text))
890-
(port-count-lines! text-port)
891-
(define parsed (grammar-parser (tokenize text-port)))
892-
(render grammar parsed)
893-
)

0 commit comments

Comments
 (0)