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

make scribble's part/document/element/etc structs all be #:transparent

Browse Source 
original commit: 4d7f6d79353fc818d847de6bd99c224c50005689
This commit is contained in:
Robby Findler 2012-06-19 01:29:30 -05:00
parent c77b67ea80
commit 2fed399324
2 changed files with 19 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
collects/scribble/core.rkt
View File

@ -6,8 +6,8 @@
;; ---------------------------------------- ;; ----------------------------------------
(define-struct collect-info (fp ht ext-ht parts tags gen-prefix relatives parents)) (define-struct collect-info (fp ht ext-ht parts tags gen-prefix relatives parents) #:transparent)
(define-struct resolve-info (ci delays undef searches)) (define-struct resolve-info (ci delays undef searches) #:transparent)
(define (part-collected-info part ri) (define (part-collected-info part ri)
(hash-ref (collect-info-parts (resolve-info-ci ri)) (hash-ref (collect-info-parts (resolve-info-ci ri))
@ -219,7 +219,8 @@
(vector (traverse-block-block d ri)))) (vector (traverse-block-block d ri))))
#'deserialize-traverse-block #'deserialize-traverse-block
#f #f
(or (current-load-relative-directory) (current-directory)))) (or (current-load-relative-directory) (current-directory)))
#:transparent)
(define block-traverse-procedure/c (define block-traverse-procedure/c
(recursive-contract (recursive-contract
@ -268,7 +269,8 @@
(vector (traverse-element-content d ri)))) (vector (traverse-element-content d ri))))
#'deserialize-traverse-element #'deserialize-traverse-element
#f #f
(or (current-load-relative-directory) (current-directory)))) (or (current-load-relative-directory) (current-directory)))
#:transparent)
(define element-traverse-procedure/c (define element-traverse-procedure/c
(recursive-contract (recursive-contract
@ -322,7 +324,8 @@
(vector (delayed-element-content d ri))))) (vector (delayed-element-content d ri)))))
#'deserialize-delayed-element #'deserialize-delayed-element
#f #f
(or (current-load-relative-directory) (current-directory)))) (or (current-load-relative-directory) (current-directory)))
#:transparent)
(provide/contract (provide/contract
(struct delayed-element ([resolve (any/c part? resolve-info? . -> . content?)] (struct delayed-element ([resolve (any/c part? resolve-info? . -> . content?)]
@ -365,7 +368,8 @@
(part-relative-element-content d ri))))) (part-relative-element-content d ri)))))
#'deserialize-part-relative-element #'deserialize-part-relative-element
#f #f
(or (current-load-relative-directory) (current-directory)))) (or (current-load-relative-directory) (current-directory)))
#:transparent)
(provide/contract (provide/contract
(struct part-relative-element ([collect (collect-info? . -> . content?)] (struct part-relative-element ([collect (collect-info? . -> . content?)]
@ -407,7 +411,8 @@
(delayed-element-content d ri))))) (delayed-element-content d ri)))))
#'deserialize-delayed-index-desc #'deserialize-delayed-index-desc
#f #f
(or (current-load-relative-directory) (current-directory)))) (or (current-load-relative-directory) (current-directory)))
#:transparent)
(provide/contract (provide/contract
(struct delayed-index-desc ([resolve (any/c part? resolve-info? . -> . any)]))) (struct delayed-index-desc ([resolve (any/c part? resolve-info? . -> . any)])))
@ -429,7 +434,8 @@
(element-content d)))) (element-content d))))
#'deserialize-collect-element #'deserialize-collect-element
#f #f
(or (current-load-relative-directory) (current-directory)))) (or (current-load-relative-directory) (current-directory)))
#:transparent)
(provide deserialize-collect-element) (provide deserialize-collect-element)
(define deserialize-collect-element (define deserialize-collect-element
@ -452,7 +458,8 @@
(element-content d)))) (element-content d))))
#'deserialize-render-element #'deserialize-render-element
#f #f
(or (current-load-relative-directory) (current-directory)))) (or (current-load-relative-directory) (current-directory)))
#:transparent)
(provide deserialize-render-element) (provide deserialize-render-element)
(define deserialize-render-element (define deserialize-render-element
@ -481,7 +488,8 @@
"serialization failed (wrong resolve info?)"))))) "serialization failed (wrong resolve info?)")))))
#'deserialize-generated-tag #'deserialize-generated-tag
#f #f
(or (current-load-relative-directory) (current-directory)))) (or (current-load-relative-directory) (current-directory)))
#:transparent)
(provide (struct-out generated-tag)) (provide (struct-out generated-tag))

2
collects/scribble/private/provide-structs.rkt
View File

@ -9,7 +9,7 @@
(syntax-case stx () (syntax-case stx ()
[(_ (id ([field ct] ...)) ...) [(_ (id ([field ct] ...)) ...)
#`(begin #`(begin
(define-serializable-struct id (field ...)) ... (define-serializable-struct id (field ...) #:transparent) ...
(provide/contract (provide/contract
#,@(let ([ids (syntax->list #'(id ...))] #,@(let ([ids (syntax->list #'(id ...))]
[fields+cts (syntax->list #'(([field ct] ...) ...))]) [fields+cts (syntax->list #'(([field ct] ...) ...))])