Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-03 11:16:36 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

Better (chibi show) documentation.

Browse source
This commit is contained in:
Alex Shinn 2014-06-18 00:47:02 +09:00
parent 56c91800c7
commit 08a2e75613
6 changed files with 134 additions and 49 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
Makefile
View file

@ -37,7 +37,8 @@ INCLUDES = $(BASE_INCLUDES) include/chibi/eval.h
MODULE_DOCS := ast config disasm equiv filesystem generic heap-stats io \
loop match mime modules net pathname process repl scribble stty \
system test time trace type-inference uri weak monad/environment
system test time trace type-inference uri weak monad/environment \
show show/base
HTML_LIBS = $(MODULE_DOCS:%=doc/lib/chibi/%.html)

22
lib/chibi/doc.scm
View file

@ -447,6 +447,8 @@ div#footer {padding-bottom: 50px}
(list (cons name args)))
(('define (name . args) . body)
(list (cons name (get-optionals args body))))
(('define name value)
(list name))
(('define-syntax name ('syntax-rules () (clause . body) ...))
;; TODO: smarter summary
(map (lambda (x) (cons name (cdr x)))
@ -558,8 +560,11 @@ div#footer {padding-bottom: 50px}
orig-ls)
(else
(let ((name
(or name
(if (eq? 'const: (caar sig)) (cadr (cdar sig)) (caar sig)))))
(cond
(name)
((not (pair? (car sig))) (car sig))
((eq? 'const: (caar sig)) (cadr (cdar sig)))
(else (caar sig)))))
(let lp ((ls orig-ls) (rev-pre '()))
(cond
((or (null? ls)
@ -574,7 +579,7 @@ div#footer {padding-bottom: 50px}
`((subsection
tag: ,(write-to-string name)
(rawcode
,@(if (eq? 'const: (caar sig))
,@(if (and (pair? (car sig)) (eq? 'const: (caar sig)))
`((i ,(write-to-string (car (cdar sig))) ": ")
,(write-to-string (cadr (cdar sig))))
(intersperse (map write-signature sig) '(br)))))))
@ -676,6 +681,17 @@ div#footer {padding-bottom: 50px}
(lp '() '() (append (insert-signature cur (caar procs) sigs)
res)
line))
((and (null? procs)
(assq (match form
(('define (name . x) . y) name)
(((or 'define 'define-syntax) name . x) name)
(((or 'define-c 'define-c-const) t (name . x) . y)
name)
(((or 'define-c 'define-c-const) t name . x)
name)
(else #f))
all-defs))
(lp '() '() (append (insert-signature cur #f sigs) res) line))
(else
(lp '() '() (append cur res) line)))))))))))

4
lib/chibi/modules.scm
View file

@ -48,14 +48,14 @@
(dir (module-dir mod)))
(define (module-file f)
(find-module-file (string-append dir f)))
(map module-file (module-metas mod '(include)))))
(map module-file (reverse (module-metas mod '(include))))))
(define (module-shared-includes mod)
(let* ((mod (if (module? mod) mod (find-module mod)))
(dir (module-dir mod)))
(define (module-file f)
(find-module-file (string-append dir f ".stub")))
(let lp ((ls (module-metas mod '(include-shared))) (res '()))
(let lp ((ls (reverse (module-metas mod '(include-shared)))) (res '()))
(cond ((null? ls) (reverse res))
((module-file (car ls)) => (lambda (x) (lp (cdr ls) (cons x res))))
(else (lp (cdr ls) res))))))

97
lib/chibi/show/base.scm
View file

@ -9,26 +9,32 @@
;;> \section{Background}
;;>
;;> There are several approaches to text formatting. Building strings to
;;> \q{display} is not acceptable, since it doesn't scale to very large
;;> output. The simplest realistic idea, and what people resort to in
;;> typical portable Scheme, is to interleave \q{display} and \q{write}
;;> and manual loops, but this is both extremely verbose and doesn't
;;> compose well. A simple concept such as padding space can't be
;;> achieved directly without somehow capturing intermediate output.
;;> There are several approaches to text formatting. Building strings
;;> to \scheme{display} is not acceptable, since it doesn't scale to
;;> very large output. The simplest realistic idea, and what people
;;> resort to in typical portable Scheme, is to interleave
;;> \scheme{display} and \scheme{write} and manual loops, but this is
;;> both extremely verbose and doesn't compose well. A simple concept
;;> such as padding space can't be achieved directly without somehow
;;> capturing intermediate output.
;;>
;;> The traditional approach is to use templates - typically strings,
;;> though in theory any object could be used and indeed Emacs' mode-line
;;> format templates allow arbitrary sexps. Templates can use either
;;> escape sequences (as in C's \q{printf} and \urlh{#BIBITEM_2}{CL's}
;;> \q{format}) or pattern matching (as in Visual Basic's \q{Format},
;;> \urlh{#BIBITEM_6}{Perl6's} \q{form}, and SQL date formats). The
;;> primary disadvantage of templates is the relative difficulty (usually
;;> impossibility) of extending them, their opaqueness, and the
;;> unreadability that arises with complex formats. Templates are not
;;> without their advantages, but they are already addressed by other
;;> libraries such as \urlh{#BIBITEM_3}{SRFI-28} and
;;> \urlh{#BIBITEM_4}{SRFI-48}.
;;> though in theory any object could be used and indeed Emacs'
;;> mode-line format templates allow arbitrary sexps. Templates can
;;> use either escape sequences (as in C's \cfun{printf} and
;;> \hyperlink["http://en.wikipedia.org/wiki/Format_(Common_Lisp)"]{CL's}
;;> \scheme{format}) or pattern matching (as in Visual Basic's
;;> \cfun{Format},
;;> \hyperlink["http://search.cpan.org/~dconway/Perl6-Form-0.04/Form.pm"}{Perl6's}
;;> \cfun{form}, and SQL date formats). The primary disadvantage of
;;> templates is the relative difficulty (usually impossibility) of
;;> extending them, their opaqueness, and the unreadability that
;;> arises with complex formats. Templates are not without their
;;> advantages, but they are already addressed by other libraries such
;;> as
;;> \hyperlink["http://srfi.schemers.org/srfi-28/srfi-28.html"]{SRFI-28}
;;> and
;;> \hyperlink["http://srfi.schemers.org/srfi-48/srfi-48.html"]{SRFI-48}.
;;>
;;> This library takes a combinator approach. Formats are nested chains
;;> of closures, which are called to produce their output as needed.
@ -39,8 +45,9 @@
;;> where necessary. The third goal is brevity and ease of use.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The environment monad with some pre-defined fields for combinator
;; formatting.
;;> The environment monad with some pre-defined fields for combinator
;;> formatting.
(define-environment-monad Show-Env
(sequence: sequence)
@ -65,11 +72,6 @@
(writer env-writer env-writer-set!)
(output env-output env-output-set!)))
(define-syntax with
(syntax-rules ()
((with params x) (%with params (displayed x)))
((with params . x) (%with params (each . x)))))
;; The base formatting handles outputting raw strings and a simple,
;; configurable handler for formatting objects.
@ -79,17 +81,6 @@
(end (if (and (pair? o) (pair? (cdr o))) (cadr o) (string-length str))))
(- end start)))
;; Raw output - displays str to the formatter output port and updates
;; row and col.
(define (output-default str)
(fn (port row col string-width)
(display str port)
(let ((nl-index (string-find-right str #\newline)))
(if (> nl-index 0)
(update! (row (+ row (string-count str #\newline)))
(col (string-width str nl-index)))
(update! (col (+ col (string-width str))))))))
;; Raw output. All primitive output should go through this operation.
;; Overridable, defaulting to output-default.
(define (output str)
@ -97,6 +88,10 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;> \section{Interface}
;;> \procedure{(show out [args ...])}
;;>
;;> The primary interface. Analogous to CL's \scheme{format}, the first
;;> argument is either an output port or a boolean, with \scheme{#t}
;;> indicating \scheme{current-output-port} and \scheme{#f} indicating a
@ -130,12 +125,12 @@
(string-width substring-length))
proc)))
;;> Captures the output of \var{producer} and formats the result with
;;> \var{consumer}.
(define (call-with-output producer consumer)
(let ((out (open-output-string)))
(fn-fork (with ((port out)) producer)
(fn () (consumer (get-output-string out))))))
;;> Shortcut syntax for \scheme{(bind (...) (each ...))}.
(define-syntax with
(syntax-rules ()
((with params x) (%with params (displayed x)))
((with params . x) (%with params (each . x)))))
;;> The noop formatter. Generates no output and leaves the state
;;> unmodified.
@ -168,3 +163,21 @@
;;> directly and other objects will be \scheme{written}.
(define (each . args)
(each-in-list args))
;;> Raw output - displays str to the formatter output port and updates
;;> row and col.
(define (output-default str)
(fn (port row col string-width)
(display str port)
(let ((nl-index (string-find-right str #\newline)))
(if (> nl-index 0)
(update! (row (+ row (string-count str #\newline)))
(col (string-width str nl-index)))
(update! (col (+ col (string-width str))))))))
;;> Captures the output of \var{producer} and formats the result with
;;> \var{consumer}.
(define (call-with-output producer consumer)
(let ((out (open-output-string)))
(fn-fork (with ((port out)) producer)
(fn () (consumer (get-output-string out))))))

54
lib/chibi/show/show.scm
View file

@ -2,6 +2,11 @@
;; Copyright (c) 2013 Alex Shinn. All rights reserved.
;; BSD-style license: http://synthcode.com/license.txt
;;> Convenience library that exports all of \scheme{(chibi show base)}
;;> plus additional combinator formatters.
;;> \section{Formatters}
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Spacing
@ -35,12 +40,19 @@
(let ((output* (lambda (str) (fn () (output (proc str))))))
(with ((output output*)) (each-in-list ls)))))
;;> Show each of \var{ls}, uppercasing all generated text.
(define (upcased . ls) (apply with-string-transformer string-upcase ls))
;;> Show each of \var{ls}, lowercasing all generated text.
(define (downcased . ls) (apply with-string-transformer string-downcase ls))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Padding and trimming
;;> Pad the result of \scheme{(each-in-list ls)} to at least
;;> \var{width} characters, equally applied to the left and right,
;;> with any extra odd padding applied to the right. Uses the value
;;> of \scheme{pad-char} for padding, defaulting to \scheme{#\\space}.
(define (padded/both width . ls)
(call-with-output
(each-in-list ls)
@ -56,6 +68,7 @@
(each right str left))
(displayed str)))))))
;;> As \scheme{padded/both} but only applies padding on the right.
(define (padded width . ls)
(fn ((col1 col))
(each (each-in-list ls)
@ -63,8 +76,10 @@
(displayed (make-string (max 0 (- width (- col2 col1)))
pad-char))))))
;;> An alias for \scheme{padded}.
(define padded/right padded)
;;> As \scheme{padded/both} but only applies padding on the left.
(define (padded/left width . ls)
(call-with-output
(each-in-list ls)
@ -85,6 +100,11 @@
(proc str str-width diff)
str)))))))
;;> Trims the result of \scheme{(each-in-list ls)} to at most
;;> \var{width} characters, removed from the right. If any characters
;;> are removed, then the value of \scheme{ellipsis} (default empty)
;;> is used in its place (trimming additional characters as needed to
;;> be sure the final output doesn't exceed \var{width}).
(define (trimmed width . ls)
(trimmed/buffered
width
@ -99,8 +119,10 @@
(substring str 0 (- width ell-len)))
ell))))))
;;> An alias for \scheme{trimmed}.
(define trimmed/right trimmed)
;;> As \scheme{trimmed} but removes from the left.
(define (trimmed/left width . ls)
(trimmed/buffered
width
@ -115,6 +137,9 @@
nothing
(substring str diff))))))))
;;> As \scheme{trimmed} but removes equally from both the left and the
;;> right, removing extra odd characters from the right, and inserting
;;> \scheme{ellipsis} on both sides.
(define (trimmed/both width . ls)
(trimmed/buffered
width
@ -130,6 +155,11 @@
ell
(each ell (substring str left right) ell)))))))
;;> A \scheme{trimmed}, but truncates and terminates immediately if
;;> more than \var{width} characters are generated by \var{ls}. Thus
;;> \var{ls} may lazily generate an infinite amount of output safely
;;> (e.g. \scheme{write-simple} on an infinite list). The nature of
;;> this procedure means only truncating on the right is meaningful.
(define (trimmed/lazy width . ls)
(fn (orig-output string-width)
(call-with-current-continuation
@ -149,11 +179,21 @@
(with ((output output*))
(each-in-list ls)))))))
;;> Fits the result of \scheme{(each-in-list ls)} to exactly
;;> \var{width} characters, padding or trimming on the right as
;;> needed.
(define (fitted width . ls)
(padded width (trimmed width (each-in-list ls))))
;;> An alias for \scheme{fitted}.
(define fitted/right fitted)
;;> As \scheme{fitted} but pads/trims from the left.
(define (fitted/left width . ls)
(padded/left width (trimmed/left width (each-in-list ls))))
;;> As \scheme{fitted} but pads/trims equally from both the left and
;;> the right.
(define (fitted/both width . ls)
(padded/both width (trimmed/both width (each-in-list ls))))
@ -173,23 +213,37 @@
(else
nothing)))))
;;> \procedure{(joined elt-f ls [sep])}
;;>
;;> Joins the result of applying \var{elt-f} to each element of the
;;> list \var{ls} together with \var{sep}, which defaults to the empty
;;> string.
(define (joined elt-f ls . o)
(joined/general elt-f #f #f ls (if (pair? o) (car o) "")))
;;> As \scheme{joined} but treats the separator as a prefix, inserting
;;> before every element instead of between.
(define (joined/prefix elt-f ls . o)
(if (null? ls)
nothing
(let ((sep (if (pair? o) (car o) "")))
(each sep (joined elt-f ls sep)))))
;;> As \scheme{joined} but treats the separator as a suffix, inserting
;;> after every element instead of between.
(define (joined/suffix elt-f ls . o)
(if (null? ls)
nothing
(let ((sep (if (pair? o) (car o) "")))
(each (joined elt-f ls sep) sep))))
;;> As \scheme{joined} but applies \var{last-f}, instead of
;;> \var{elt-f}, to the last element of \var{ls}, useful for
;;> e.g. commas separating a list with "and" before the final element.
(define (joined/last elt-f last-f ls . o)
(joined/general elt-f last-f #f ls (if (pair? o) (car o) "")))
;;> As \scheme{joined} but if \var{ls} is a dotted list applies
;;> \var{dot-f} to the dotted tail as a final element.
(define (joined/dot elt-f dot-f ls . o)
(joined/general elt-f #f dot-f ls (if (pair? o) (car o) "")))

3
lib/chibi/show/write.scm
View file

@ -3,7 +3,8 @@
;; BSD-style license: http://synthcode.com/license.txt
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; string utils
;;> \section{String utilities}
(define (write-to-string x)
(let ((out (open-output-string)))