94 lines
4.0 KiB
Scheme
94 lines
4.0 KiB
Scheme
(module java-scribble scheme/base
|
|
|
|
(require scribble/struct scribble/basic scribble/scheme scribble/manual scribble/decode)
|
|
|
|
(define (*javagrammars style nonterms clauseses)
|
|
(make-table
|
|
`((valignment baseline baseline baseline baseline baseline)
|
|
(alignment right left center left left)
|
|
(style ,style))
|
|
(let ([empty-line (make-flow (list (make-paragraph (list (tt 'nbsp)))))]
|
|
[to-flow (lambda (i) (make-flow (list (make-paragraph (list i)))))])
|
|
(cdr
|
|
(apply append
|
|
(map
|
|
(lambda (nonterm clauses)
|
|
(list*
|
|
(list empty-line empty-line empty-line empty-line empty-line)
|
|
(list (to-flow nonterm)
|
|
empty-line
|
|
(to-flow "=")
|
|
empty-line
|
|
(make-flow (list (car clauses))))
|
|
(map (lambda (clause)
|
|
(list empty-line
|
|
empty-line
|
|
(to-flow "|")
|
|
empty-line
|
|
(make-flow (list clause))))
|
|
(cdr clauses))))
|
|
nonterms clauseses))))))
|
|
|
|
(define (*javagrammar lits s-expr clauseses-thunk)
|
|
(parameterize ([current-variable-list
|
|
(let loop ([form s-expr])
|
|
(cond
|
|
[(symbol? form) (if (memq form lits)
|
|
null
|
|
(list form))]
|
|
[(pair? form) (append (loop (car form))
|
|
(loop (cdr form)))]
|
|
[else null]))])
|
|
(let ([l (clauseses-thunk)])
|
|
(*javagrammars #f
|
|
(map (lambda (x)
|
|
(make-element #f
|
|
(list (hspace 2)
|
|
(car x))))
|
|
l)
|
|
(map cdr l)))))
|
|
|
|
(define-syntax java
|
|
(syntax-rules ()
|
|
((_ term) (tt term))))
|
|
|
|
(define-syntax javablock
|
|
(syntax-rules ()
|
|
[(_ term ...) (make-table #f
|
|
(list (list (make-flow (list (make-paragraph (list (java term))))) ...)))]))
|
|
|
|
(define-syntax javagrammar
|
|
(syntax-rules ()
|
|
[(_ #:literals (lit ...) id (#:tag t term ...) ...)
|
|
(*javagrammar '(lit ...)
|
|
'(id term ... ...)
|
|
(lambda () (list (list (scheme id)
|
|
(make-table #f
|
|
(list (list
|
|
(make-flow (list
|
|
(make-paragraph
|
|
(list (elemref t (scheme term ...))))))) ...))))))]
|
|
[(_ #:literals (lit ...) id (term ...) ...)
|
|
(*javagrammar '(lit ...)
|
|
'(id term ... ...)
|
|
(lambda () (list (list (scheme id)
|
|
(make-table #f
|
|
(list (list
|
|
(make-flow (list
|
|
(make-paragraph
|
|
(list (scheme term ...)))))) ...))))))]
|
|
[(_ #:tag t id (term ...) ...)
|
|
(javagrammar #:literals () id (#:tag t term ...) ...)]
|
|
[(_ #:literals (lit ...) #:tag t id (term ...) ...)
|
|
(javagrammar #:literals (lit ...) id (#:tag t term ...) ...)]
|
|
[(_ id (#:tag t term ...) ...)
|
|
(javagrammar #:literals () id (#:tag t term ...) ...)]
|
|
[(_ id (term ...) ...) (javagrammar #:literals () id (term ...) ...)]))
|
|
|
|
(define semi (tt ";"))
|
|
|
|
(provide java javagrammar javablock semi)
|
|
|
|
|
|
)
|