Skip to content

Automated Resyntax fixes #483

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 10 commits into
base: master
Choose a base branch
from
31 changes: 12 additions & 19 deletions scribble-lib/scribble/private/doc-begin.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -66,22 +66,15 @@
#'(check-pre-part s (quote-syntax loc))))]))

(define (check-pre-part v loc-stx)
(if (pre-part? v)
v
(error
(format
"~a: not valid in document body (need a pre-part for decode) in: ~e"
(cond
[(and (syntax-source loc-stx)
(syntax-line loc-stx))
(format "~a:~a:~a"
(syntax-source loc-stx)
(syntax-line loc-stx)
(syntax-column loc-stx))]
[(and (syntax-source loc-stx)
(syntax-position loc-stx))
(format "~a:::~a"
(syntax-source loc-stx)
(syntax-position loc-stx))]
[else 'document])
v))))
(unless (pre-part? v)
(error
(format
"~a: not valid in document body (need a pre-part for decode) in: ~e"
(cond
[(and (syntax-source loc-stx) (syntax-line loc-stx))
(format "~a:~a:~a" (syntax-source loc-stx) (syntax-line loc-stx) (syntax-column loc-stx))]
[(and (syntax-source loc-stx) (syntax-position loc-stx))
(format "~a:::~a" (syntax-source loc-stx) (syntax-position loc-stx))]
[else 'document])
v)))
v)
189 changes: 85 additions & 104 deletions scribble-lib/scribble/private/manual-bind.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -59,10 +59,7 @@
(define hovers (make-weak-hasheq))
(define (intern-hover-style text)
(let ([text (datum-intern-literal text)])
(or (hash-ref hovers text #f)
(let ([s (make-style #f (list (make-hover-property text)))])
(hash-set! hovers text s)
s))))
(hash-ref! hovers text (λ () (make-style #f (list (make-hover-property text)))))))

(define (annote-exporting-library e)
(make-delayed-element
Expand All @@ -71,15 +68,14 @@
(if (and from (pair? from))
(make-element
(intern-hover-style
(string-append
"Provided from: "
(string-join (map ~s from) ", ")
(let ([from-pkgs (resolve-get/tentative p ri '(exporting-packages #f))])
(if (and from-pkgs (pair? from-pkgs))
(string-append
" | Package: "
(string-join (map ~a from-pkgs) ", "))
""))))
(string-join (map ~s from)
", "
#:before-first "Provided from: "
#:after-last
(let ([from-pkgs (resolve-get/tentative p ri '(exporting-packages #f))])
(if (and from-pkgs (pair? from-pkgs))
(string-append " | Package: " (string-join (map ~a from-pkgs) ", "))
""))))
e)
e))
(lambda () e)
Expand Down Expand Up @@ -114,30 +110,30 @@
(lambda (x add) x)))
(let ([lib
(or (for/or ([lib (in-list (or source-libs null))])
(let ([checker
(hash-ref
checkers lib
(lambda ()
(define ns-id
(let ([ns (make-base-empty-namespace)])
(parameterize ([current-namespace ns])
;; A `(namespace-require `(for-label ,lib))` can
;; fail if `lib` provides different bindings of the
;; same name at different phases. We can require phases
;; 1 and 0 separately, in which case the phase-0
;; binding shadows the phase-1 one in that case.
;; This strategy only works for documenting bindings
;; at phases 0 and 1, though.
(namespace-require `(just-meta 1 (for-label ,lib)))
(namespace-require `(just-meta 0 (for-label ,lib)))
(namespace-syntax-introduce (datum->syntax #f 'x)))))
(define (checker id intro)
(free-label-identifier=?
(intro (datum->syntax ns-id (syntax-e id)) 'add)
(intro id 'add)))
(hash-set! checkers lib checker)
checker))])
(and (checker id intro) lib)))
(define checker
(hash-ref checkers
lib
(lambda ()
(define ns-id
(let ([ns (make-base-empty-namespace)])
(parameterize ([current-namespace ns])
;; A `(namespace-require `(for-label ,lib))` can
;; fail if `lib` provides different bindings of the
;; same name at different phases. We can require phases
;; 1 and 0 separately, in which case the phase-0
;; binding shadows the phase-1 one in that case.
;; This strategy only works for documenting bindings
;; at phases 0 and 1, though.
(namespace-require `(just-meta 1 (for-label ,lib)))
(namespace-require `(just-meta 0 (for-label ,lib)))
(namespace-syntax-introduce (datum->syntax #f 'x)))))
(define (checker id intro)
(free-label-identifier=? (intro (datum->syntax ns-id (syntax-e id))
'add)
(intro id 'add)))
(hash-set! checkers lib checker)
checker)))
(and (checker id intro) lib))
(and (pair? libs) (car libs)))])
(and lib (module-path-index->taglet
(module-path-index-join lib #f)))))
Expand Down Expand Up @@ -198,79 +194,64 @@
#:show-libs? [show-libs? #t])
;; This function could have more optional argument to select
;; whether to index the id, include a toc link, etc.
(let ([dep? #t])
(define maker
(if form?
(id-to-form-target-maker id dep?)
(id-to-target-maker id dep?)))
(define-values (elem elem-ref)
(if show-libs?
(definition-site (syntax-e id) id form?)
(values (to-element id #:defn? #t)
(to-element id))))
(if maker
(maker elem
(lambda (tag)
(let ([elem
(if index?
(make-index-element
#f (list elem) tag
(list (datum-intern-literal (symbol->string (syntax-e id))))
(list elem)
(and show-libs?
(with-exporting-libraries
(lambda (libs)
(make-exported-index-desc (syntax-e id)
libs)))))
elem)])
(make-target-element #f (list elem) tag))))
elem)))
(define dep? #t)
(define maker
(if form?
(id-to-form-target-maker id dep?)
(id-to-target-maker id dep?)))
(define-values (elem elem-ref)
(if show-libs?
(definition-site (syntax-e id) id form?)
(values (to-element id #:defn? #t) (to-element id))))
(if maker
(maker elem
(lambda (tag)
(let ([elem (if index?
(make-index-element
#f
(list elem)
tag
(list (datum-intern-literal (symbol->string (syntax-e id))))
(list elem)
(and show-libs?
(with-exporting-libraries
(lambda (libs) (make-exported-index-desc (syntax-e id) libs)))))
elem)])
(make-target-element #f (list elem) tag))))
elem))

(define (make-binding-redirect-elements mod-path redirects)
(define taglet (module-path-index->taglet
(module-path-index-join mod-path #f)))
(make-element
#f
(map
(lambda (redirect)
(define id (car redirect))
(define form? (cadr redirect))
(define path (caddr redirect))
(define anchor (cadddr redirect))
(define (make-one kind)
(make-redirect-target-element
#f
null
(intern-taglet (list kind (list taglet id)))
path
anchor))
(make-element
#f
(list (make-one (if form? 'form 'def))
(make-dep (list taglet id) null)
(let ([str (datum-intern-literal (symbol->string id))])
(make-index-element #f
null
(intern-taglet
(list (if form? 'form 'def)
(list taglet id)))
(list str)
(list
(make-element
symbol-color
(list
(make-element
(if form?
syntax-link-color
value-link-color)
(list str)))))
(make-exported-index-desc*
id
(list mod-path)
(hash 'kind (if form?
"syntax"
"procedure"))))))))
redirects)))
(for/list ([redirect (in-list redirects)])
(define id (car redirect))
(define form? (cadr redirect))
(define path (caddr redirect))
(define anchor (cadddr redirect))
(define (make-one kind)
(make-redirect-target-element #f
null
(intern-taglet (list kind (list taglet id)))
path
anchor))
(make-element
#f
(list (make-one (if form? 'form 'def))
(make-dep (list taglet id) null)
(let ([str (datum-intern-literal (symbol->string id))])
(make-index-element
#f
null
(intern-taglet (list (if form? 'form 'def) (list taglet id)))
(list str)
(list (make-element symbol-color
(list (make-element (if form? syntax-link-color value-link-color)
(list str)))))
(make-exported-index-desc* id
(list mod-path)
(hash 'kind (if form? "syntax" "procedure"))))))))))


(define (make-dep t content)
Expand Down
39 changes: 15 additions & 24 deletions scribble-lib/scribble/private/manual-class.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -48,14 +48,9 @@

(define (id-info id)
(define b (identifier-label-binding id))
(if b
(list (caddr b)
(list-ref b 3)
(list-ref b 4)
(list-ref b 5)
(list-ref b 6))
(error 'scribble "no class/interface/mixin information for identifier: ~e"
id)))
(unless b
(error 'scribble "no class/interface/mixin information for identifier: ~e" id))
(list (caddr b) (list-ref b 3) (list-ref b 4) (list-ref b 5) (list-ref b 6)))
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

A combination of take and drop would be better IMO

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Excellent idea. Added in jackfirth/resyntax#444.


(define (make-inherited-table r d ri decl)
(define start
Expand Down Expand Up @@ -155,11 +150,11 @@
null))

(define (build-body decl body)
`(,@(map (lambda (i)
(cond [(constructor? i) ((constructor-def i))]
[(meth? i) ((meth-def i))]
[else i]))
body)
`(,@(for/list ([i (in-list body)])
(cond
[(constructor? i) ((constructor-def i))]
[(meth? i) ((meth-def i))]
[else i]))
,(make-delayed-block (lambda (r d ri) (make-inherited-table r d ri decl)))))

(define (*include-class/title decl link?)
Expand Down Expand Up @@ -408,17 +403,13 @@
(datum->syntax n (syntax-e n) (list 'src 1 3 4 1)))
(list 'src 1 0 1 5))]
[(((kw ...) ...) ...)
(map (lambda (ids)
(map (lambda (arg)
(if (and (pair? (syntax-e arg))
(eq? (syntax-e #'mode) 'new))
(list (string->keyword
(symbol->string
(syntax-e
(car (syntax-e arg))))))
null))
(syntax->list ids)))
(syntax->list #'((arg ...) ...)))])
(for/list ([ids (in-list (syntax->list #'((arg ...) ...)))])
(map (lambda (arg)
(if (and (pair? (syntax-e arg)) (eq? (syntax-e #'mode) 'new))
(list (string->keyword
(symbol->string (syntax-e (car (syntax-e arg))))))
null))
(syntax->list ids)))])
#'(make-constructor (lambda ()
(defproc* #:mode mode #:within name
[[(make [kw ... . arg] ...) result] ...]
Expand Down
17 changes: 10 additions & 7 deletions scribble-lib/scribble/private/manual-code.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -340,16 +340,19 @@
(list 'function start end 1)] ; this looses information
[_ tok])))

(define (make-test-result lst)
(define-values (res _)
(for/fold ([result null] [count 12])
(define (make-test-result lst)
(define res
(for/fold ([result null]
[count 12]
#:result result)
([p lst])
(define next (+ count (second p)))
(define r (if (eq? (first p) 'function) 1 0))
(values
(cons (list (first p) count next r) result)
next)))
(list* `(function 0 5 1) `(white-space 5 6 0) `(function 6 12 1) `(function 6 12 1)
(values (cons (list (first p) count next r) result) next)))
(list* `(function 0 5 1)
`(white-space 5 6 0)
`(function 6 12 1)
`(function 6 12 1)
(reverse res)))

(check-equal?
Expand Down
21 changes: 9 additions & 12 deletions scribble-lib/scribble/private/manual-mod.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -299,12 +299,9 @@
pkg-spec))))
libs-specs))
(append (if link-target?
(map (lambda (modpath)
(make-part-tag-decl
(intern-taglet
`(mod-path ,(datum-intern-literal
(element->string modpath))))))
modpaths)
(for/list ([modpath (in-list modpaths)])
(make-part-tag-decl (intern-taglet `(mod-path ,(datum-intern-literal
(element->string modpath))))))
null)
(flow-paragraphs (decode-flow content)))))))

Expand Down Expand Up @@ -334,12 +331,12 @@
#'(list pkg ...)
#'#f)])
(let ([libs (syntax->list #'(lib ... plib ...))])
(for ([l libs])
(unless (or (syntax-case l (unquote)
[(unquote _) #t]
[_ #f])
(module-path? (syntax->datum l)))
(raise-syntax-error #f "not a module path" stx l)))
(for ([l libs]
#:unless (or (syntax-case l (unquote)
[(unquote _) #t]
[_ #f])
(module-path? (syntax->datum l))))
(raise-syntax-error #f "not a module path" stx l))
(when (null? libs)
(raise-syntax-error #f "need at least one module path" stx))
#'(*declare-exporting `(lib ...) `(plib ...) packages)))]))
Expand Down
Loading