diff --git a/Makefile b/Makefile index f11ec1f7..88af034e 100644 --- a/Makefile +++ b/Makefile @@ -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) diff --git a/lib/chibi/doc.scm b/lib/chibi/doc.scm index c7a1d9f0..ff310f6e 100644 --- a/lib/chibi/doc.scm +++ b/lib/chibi/doc.scm @@ -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))))))))))) diff --git a/lib/chibi/modules.scm b/lib/chibi/modules.scm index feca5177..08db363e 100644 --- a/lib/chibi/modules.scm +++ b/lib/chibi/modules.scm @@ -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)))))) diff --git a/lib/chibi/show/base.scm b/lib/chibi/show/base.scm index e7d719c1..c5c569d8 100644 --- a/lib/chibi/show/base.scm +++ b/lib/chibi/show/base.scm @@ -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)))))) diff --git a/lib/chibi/show/show.scm b/lib/chibi/show/show.scm index 48ce8d1d..60490371 100644 --- a/lib/chibi/show/show.scm +++ b/lib/chibi/show/show.scm @@ -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) ""))) diff --git a/lib/chibi/show/write.scm b/lib/chibi/show/write.scm index 6d2c4e17..d5218a85 100644 --- a/lib/chibi/show/write.scm +++ b/lib/chibi/show/write.scm @@ -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)))