Skip to content
Merged
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
59 changes: 44 additions & 15 deletions srfi-tools/library.sld
Original file line number Diff line number Diff line change
@@ -1,5 +1,8 @@
(define-library (srfi-tools library)
(export srfi-library-names-sxml
(export srfi-map-library-names
srfi-library-names
srfi-r6rs-imports
srfi-library-names-sxml
srfi-generate-library-names)
(import (scheme base)

Expand All @@ -14,6 +17,38 @@
(srfi-tools url))
(begin

(define (srfi-map-library-names proc)
(filter-map (lambda (srfi)
(let ((name (srfi-library-name srfi)))
(and name (proc (srfi-number srfi) name))))
(srfi-list)))

(define (srfi-library-names)
(srfi-map-library-names cons))

(define-command (library-names)
"List library names (SRFI 97 and beyond)."
(display-two-column-table (srfi-library-names)))

(define (r6rs-import num name)
;; Return a string instead of an S-expression because symbols
;; starting with a colon are handled inconsistently by Scheme
;; implementations. Some of them escape such symbols to avoid
;; confusing them with keywords. R6RS standard syntax does not
;; support those escapes.
(format "(import (srfi :~a ~a))" num name))

(define (r7rs-import num name)
;; R7RS may add the names at some point.
(format "(import (srfi ~a))" num))

(define (srfi-r6rs-imports)
(srfi-map-library-names r6rs-import))

(define-command (r6rs-imports)
"List R6RS (import ...) for each SRFI (SRFI 97 and beyond)."
(for-each write-line (srfi-r6rs-imports)))

(define (srfi-library-names-sxml)
(let ((title "SRFI library names"))
`(html
Expand All @@ -31,19 +66,13 @@
(tr (th "")
(th "R6RS")
(th "R7RS"))
,@(filter-map
(lambda (srfi)
(let ((num (srfi-number srfi))
(name (srfi-library-name srfi)))
(and name
`(tr (td (a (@ (href ,(srfi-landing-url num))
(title ,(srfi-title srfi)))
"SRFI " ,(number->string num)))
(td (code ,(format "(import (srfi :~a ~a))"
num name)))
(td (code ,(format "(import (srfi ~a))"
num)))))))
(srfi-list)))))))
,@(srfi-map-library-names
(lambda (num name)
`(tr (td (a (@ (href ,(srfi-landing-url num))
(title ,(srfi-title num)))
"SRFI " ,(number->string num)))
(td (code ,(r6rs-import num name)))
(td (code ,(r7rs-import num name)))))))))))

(define (srfi-generate-library-names)
(let ((file (path-append (srfi-common-dir) "library-names.html"))
Expand All @@ -52,5 +81,5 @@
(write-html-file file sxml)))

(define-command (generate-library-names)
"Display the SRFI 97 library names."
"Write web page of library names (SRFI 97 and beyond)."
(srfi-generate-library-names))))