suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

get rid of for-values, change document format for mini-grammars

Browse Source 
svn: r6549

original commit: 7d7cae8bf248c401674bc372202c2173e8c3dbfd
This commit is contained in:
Matthew Flatt 2007-06-09 01:13:52 +00:00
parent 5eb37f8ab6
commit 32a99e7b85
4 changed files with 82 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/scribble/html-render.ss
View File

@ -203,6 +203,7 @@
`(td (,@(case a `(td (,@(case a
[(#f) null] [(#f) null]
[(right) '((align "right"))] [(right) '((align "right"))]
[(center) '((align "center"))]
[(left) '((align "left"))]) [(left) '((align "left"))])
,@(case va ,@(case va
[(#f) null] [(#f) null]

3
collects/scribble/latex-render.ss
View File

@ -241,6 +241,9 @@
[(#\<) (if (rendering-tt) [(#\<) (if (rendering-tt)
(display "{\\texttt <}") (display "{\\texttt <}")
(display "$<$"))] (display "$<$"))]
[(#\|) (if (rendering-tt)
(display "{\\texttt |}")
(display "$|$"))]
[(#\? #\! #\. #\:) (if (rendering-tt) [(#\? #\! #\. #\:) (if (rendering-tt)
(printf "{\\hbox{\\texttt{~a}}}" c) (printf "{\\hbox{\\texttt{~a}}}" c)
(display c))] (display c))]

100
collects/scribble/manual.ss
View File

@ -146,8 +146,9 @@
;; ---------------------------------------- ;; ----------------------------------------
(provide defproc defproc* defstruct defthing defform defform* defform/none (provide defproc defproc* defstruct defthing defform defform* defform/subs defform*/subs defform/none
specform specsubform specsubform/inline specform specsubform specsubform/inline
schemegrammar
var svar void-const undefined-const) var svar void-const undefined-const)
(define void-const (define void-const
@ -205,9 +206,9 @@
(syntax-rules () (syntax-rules ()
[(_ name fields desc ...) [(_ name fields desc ...)
(*defstruct 'name 'fields (lambda () (list desc ...)))])) (*defstruct 'name 'fields (lambda () (list desc ...)))]))
(define-syntax (defform* stx) (define-syntax (defform*/subs stx)
(syntax-case stx () (syntax-case stx ()
[(_ [spec spec1 ...] desc ...) [(_ [spec spec1 ...] ([non-term-id non-term-form ...] ...) desc ...)
(with-syntax ([new-spec (with-syntax ([new-spec
(syntax-case #'spec () (syntax-case #'spec ()
[(name . rest) [(name . rest)
@ -218,17 +219,32 @@
#'name) #'name)
#'rest) #'rest)
#'spec)])]) #'spec)])])
#'(*defforms #t '(spec spec1 ...) #'(*defforms #t
'(spec spec1 ...)
(list (lambda (x) (schemeblock0 new-spec)) (list (lambda (x) (schemeblock0 new-spec))
(lambda (ignored) (schemeblock0 spec1)) ...) (lambda (ignored) (schemeblock0 spec1)) ...)
'((non-term-id non-term-form ...) ...)
(list (list (lambda () (scheme non-term-id))
(lambda () (schemeblock0 non-term-form))
...)
...)
(lambda () (list desc ...))))])) (lambda () (list desc ...))))]))
(define-syntax (defform* stx)
(syntax-case stx ()
[(_ [spec ...] desc ...) #'(defform*/subs [spec ...] () desc ...)]))
(define-syntax (defform stx) (define-syntax (defform stx)
(syntax-case stx () (syntax-case stx ()
[(_ spec desc ...) #'(defform* [spec] desc ...)])) [(_ spec desc ...) #'(defform*/subs [spec] () desc ...)]))
(define-syntax (defform/subs stx)
(syntax-case stx ()
[(_ spec subs desc ...) #'(defform*/subs [spec] subs desc ...)]))
(define-syntax (defform/none stx) (define-syntax (defform/none stx)
(syntax-case stx () (syntax-case stx ()
[(_ spec desc ...) [(_ spec desc ...)
#'(*defforms #f '(spec) (list (lambda (ignored) (schemeblock0 spec))) (lambda () (list desc ...)))])) #'(*defforms #f
'(spec) (list (lambda (ignored) (schemeblock0 spec)))
null null
(lambda () (list desc ...)))]))
(define-syntax specsubform (define-syntax specsubform
(syntax-rules () (syntax-rules ()
[(_ spec desc ...) [(_ spec desc ...)
@ -245,6 +261,9 @@
(syntax-rules () (syntax-rules ()
[(_ id result desc ...) [(_ id result desc ...)
(*defthing 'id 'result (lambda () (list desc ...)))])) (*defthing 'id 'result (lambda () (list desc ...)))]))
(define-syntax schemegrammar
(syntax-rules ()
[(_ id clause ...) (*schemegrammar (scheme id) (schemeblock0 clause) ...)]))
(define-syntax var (define-syntax var
(syntax-rules () (syntax-rules ()
[(_ id) (*var 'id)])) [(_ id) (*var 'id)]))
@ -450,12 +469,13 @@
(define (meta-symbol? s) (memq s '(... ...+ ?))) (define (meta-symbol? s) (memq s '(... ...+ ?)))
(define (*defforms kw? forms form-procs content-thunk) (define (*defforms kw? forms form-procs subs sub-procs content-thunk)
(parameterize ([current-variable-list (parameterize ([current-variable-list
(apply (apply
append append
(map (lambda (form) (map (lambda (form)
(let loop ([form (if kw? (cdr form) form)]) (let loop ([form (cons (if kw? (cdr form) form)
subs)])
(cond (cond
[(symbol? form) (if (meta-symbol? form) [(symbol? form) (if (meta-symbol? form)
null null
@ -468,24 +488,32 @@
(cons (cons
(make-table (make-table
'boxed 'boxed
(map (lambda (form form-proc) (append
(list (map (lambda (form form-proc)
(make-flow (list
(list (make-flow
((or form-proc (list
(lambda (x) ((or form-proc
(make-paragraph (lambda (x)
(list (make-paragraph
(to-element (list
`(,x (to-element
. ,(cdr form))))))) `(,x
(and kw? . ,(cdr form)))))))
(eq? form (car forms)) (and kw?
(make-target-element (eq? form (car forms))
#f (make-target-element
(list (to-element (car form))) #f
(register-scheme-form-definition (car form))))))))) (list (to-element (car form)))
forms form-procs)) (register-scheme-form-definition (car form)))))))))
forms form-procs)
(apply
append
(map (lambda (sub)
(list (list (make-flow (list (make-paragraph (list (tt 'nbsp))))))
(list (make-flow (list (apply *schemegrammar
(map (lambda (f) (f)) sub)))))))
sub-procs))))
(content-thunk))))) (content-thunk)))))
(define (*specsubform form has-kw? form-thunk content-thunk) (define (*specsubform form has-kw? form-thunk content-thunk)
@ -512,6 +540,26 @@
(make-paragraph (list (to-element form))))))))) (make-paragraph (list (to-element form)))))))))
(flow-paragraphs (decode-flow (content-thunk))))))) (flow-paragraphs (decode-flow (content-thunk)))))))
(define (*schemegrammar nonterm clause1 . clauses)
(make-table
'((valignment baseline baseline baseline baseline baseline)
(alignment left left center left left))
(let ([empty-line (make-flow (list (make-paragraph (list (tt 'nbsp)))))]
[to-flow (lambda (i) (make-flow (list (make-paragraph (list i)))))])
(cons
(list (to-flow nonterm)
empty-line
(to-flow "=")
empty-line
(make-flow (list clause1)))
(map (lambda (clause)
(list empty-line
empty-line
(to-flow "|")
empty-line
(make-flow (list clause))))
clauses)))))
(define (*var id) (define (*var id)
(to-element (*var-sym id))) (to-element (*var-sym id)))

5
collects/scribble/scheme.ss
View File

@ -105,7 +105,10 @@
(set! col-map next-col-map) (set! col-map next-col-map)
(set! next-col-map (make-hash-table 'equal)) (set! next-col-map (make-hash-table 'equal))
(init-line!)) (init-line!))
(let ([d-col (hash-table-get col-map c (+ dest-col (- c src-col)))]) (let ([d-col (let ([def-val (+ dest-col (- c src-col))])
(if new-line?
(hash-table-get col-map c def-val)
def-val))])
(let ([amt (- d-col dest-col)]) (let ([amt (- d-col dest-col)])
(when (positive? amt) (when (positive? amt)
(let ([old-dest-col dest-col]) (let ([old-dest-col dest-col])