From 265d3e51360fb810bf20197682c9197cc0065873 Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Sat, 21 May 2011 22:47:48 -0700 Subject: [PATCH] Adding documentation. --- lib/chibi/ast.scm | 269 +++++++++++++++++++++++++++++++++++- lib/chibi/disasm.module | 5 + lib/chibi/equiv.scm | 5 + lib/chibi/filesystem.module | 5 + lib/chibi/filesystem.scm | 35 ++++- lib/chibi/filesystem.stub | 65 ++++++++- lib/chibi/generic.module | 2 + lib/chibi/generic.scm | 14 ++ lib/chibi/heap-stats.module | 19 +++ lib/chibi/highlight.scm | 34 ++++- lib/chibi/io/io.scm | 32 +++++ lib/chibi/loop/loop.scm | 76 +++++++--- lib/chibi/mime.scm | 127 ++++++++--------- lib/chibi/modules.module | 2 +- lib/chibi/modules.scm | 2 + 15 files changed, 587 insertions(+), 105 deletions(-) diff --git a/lib/chibi/ast.scm b/lib/chibi/ast.scm index f4506ff5..587fbd84 100644 --- a/lib/chibi/ast.scm +++ b/lib/chibi/ast.scm @@ -1,12 +1,22 @@ ;; ast.scm -- ast utilities -;; Copyright (c) 2010 Alex Shinn. All rights reserved. +;; Copyright (c) 2010-2011 Alex Shinn. All rights reserved. ;; BSD-style license: http://synthcode.com/license.txt -(define (macroexpand x) - (ast->sexp (analyze x))) +;;> Abstract Syntax Tree. Interface to the types used by +;;> the compiler, and other core types less commonly +;;> needed in user code, plus related utilities. -(define (procedure-name x) - (bytecode-name (procedure-code x))) +;;> @subsubsection{Analysis and Expansion} + +;;> @subsubsubsection{@scheme{(analyze x [env])}} + +;;> Expands and analyzes the expression @var{x} and returns the +;;> resulting AST. + +;;> @subsubsubsection{@scheme{(optimize ast)}} + +;;> Runs an optimization pass on @var{ast} and returns the +;;> resulting simplified expression. (define (ast-renames ast) (define i 0) @@ -67,6 +77,15 @@ ((null? ls) '()) (else (f ls)))) +;;> Performs a full syntax expansion of the form @var{x} and +;;> returns the resulting s-expression. + +(define (macroexpand x) + (ast->sexp (analyze x))) + +;;> Convert @var{ast} to a s-expression, renaming variables if +;;> necessary. + (define (ast->sexp ast) (let ((renames (ast-renames ast))) (let a2s ((x ast)) @@ -89,8 +108,244 @@ ((opcode? x) (or (opcode-name x) x)) (else x))))) -(define (type-parent x) - (let ((v (type-cpl x))) +;;> @subsubsection{Types} + +;;> All objects have an associated type, and types may have parent +;;> types. When using SRFI-9 @scheme{define-record-type}, the +;;> name is bound to a first class type object. + +;;> The following core types are also available by name, and may be +;;> used in the @scheme{match} @scheme{($ ...)} syntax. + +;;> @itemlist[ +;;> @item{@scheme{} - the parent of all types} +;;> @item{@scheme{} - abstract numeric type} +;;> @item{@scheme{} - arbitrary precision exact integers} +;;> @item{@scheme{} - inexact real numbers} +;;> @item{@scheme{} - abstract integer type} +;;> @item{@scheme{} - symbols} +;;> @item{@scheme{} - character} +;;> @item{@scheme{} - @scheme{#t} or @scheme{#f}} +;;> @item{@scheme{} - strings of characters} +;;> @item{@scheme{} - uniform vector of octets} +;;> @item{@scheme{} - a @var{car} and @var{cdr}, the basis for lists} +;;> @item{@scheme{} - vectors} +;;> @item{@scheme{} - a primitive opcode or C function} +;;> @item{@scheme{} - a closure} +;;> @item{@scheme{} - the compiled code for a closure} +;;> @item{@scheme{} - an environment structure} +;;> @item{@scheme{} - a macro object, usually not first-class} +;;> @item{@scheme{} - a lambda AST type} +;;> @item{@scheme{} - an conditional AST type (i.e. @scheme{if})} +;;> @item{@scheme{} - a reference AST type} +;;> @item{@scheme{} - a mutation AST type (i.e. @scheme{set!})} +;;> @item{@scheme{} - a sequence AST type} +;;> @item{@scheme{} - a literal AST type} +;;> @item{@scheme{} - a syntactic closure} +;;> @item{@scheme{} - a context object (including threads)} +;;> @item{@scheme{} - an exception object} +;;> ] + +;;> The following extended type predicates may also be used to test +;;> individual objects for their type: + +;;> @itemlist[ +;;> @item{@scheme{environment?}} +;;> @item{@scheme{bytecode?}} +;;> @item{@scheme{macro?}} +;;> @item{@scheme{syntactic-closure?}} +;;> @item{@scheme{lambda?}} +;;> @item{@scheme{cnd?}} +;;> @item{@scheme{ref?}} +;;> @item{@scheme{set?}} +;;> @item{@scheme{seq?}} +;;> @item{@scheme{lit?}} +;;> @item{@scheme{opcode?}} +;;> @item{@scheme{type?}} +;;> @item{@scheme{context?}} +;;> @item{@scheme{exception?}} +;;> ] + +;;> @subsubsubsection{@scheme{(type-of x)}} + +;;> Returns the type of any object @var{x}. + +;;> @subsubsubsection{@scheme{(type-name type)}} + +;;> Returns the name of type @var{type}. + +;;> @subsubsubsection{@scheme{(type-parent type)}} + +;;> Returns the immediate parent of type @var{type}, +;;> or @scheme{#f} for a type with no parent. + +(define (type-parent type) + (let ((v (type-cpl type))) (and (vector? v) (> (vector-length v) 1) (vector-ref v (- (vector-length v) 2))))) + +;;> @subsubsubsection{@scheme{(type-cpl type)}} + +;;> Returns the class precedence list of type @var{type} as a +;;> vector, or @scheme{#f} for a type with no parent. + +;;> @subsubsubsection{@scheme{(type-slots type)}} + +;;> Returns the slot list of type @var{type}. + +;;> @subsubsection{Accessors} + +;;> This section describes additional accessors on AST and other core +;;> types. + +;;> @subsubsubsection{Procedures} + +;;> @itemlist[ +;;> @item{@scheme{(procedure-code f)} - the compiled bytecode object} +;;> @item{@scheme{(procedure-vars f)} - the variables closed over by @var{f}} +;;> @item{@scheme{(procedure-name f)} - the name of @var{f} if known, else @scheme{#f}} +;;> ] + +(define (procedure-name x) + (bytecode-name (procedure-code x))) + +;;> @subsubsubsection{Macros} + +;;> @itemlist[ +;;> @item{@scheme{(macro-procedure f)} - the macro procedure} +;;> @item{@scheme{(macro-env f)} - the environment the macro was defined in} +;;> @item{@scheme{(macro-source f)} - the source location the macro was defined in} +;;> ] + +;;> @subsubsubsection{Bytecode Objects} + +;;> @itemlist[ +;;> @item{@scheme{(bytecode-name bc)} - the macro procedure} +;;> @item{@scheme{(bytecode-literals bc)} - literals the bytecode references} +;;> @item{@scheme{(bytecode-source bc)} - the source location the procedure was defined in} +;;> ] + +;;> @subsubsubsection{Syntactic Closures} + +;;> @itemlist[ +;;> @item{@scheme{(syntactic-closure-env sc)}} +;;> @item{@scheme{(syntactic-closure-vars sc)}} +;;> @item{@scheme{(syntactic-closure-expr sc)}} +;;> ] + +;;> Return the environment, free variables, and expression +;;> associated with @var{sc} respectively. + +;;> @subsubsubsection{Exceptions} + +;;> @itemlist[ +;;> @item{@scheme{(exception-kind exn)}} +;;> @item{@scheme{(exception-message exn)}} +;;> @item{@scheme{(exception-irritants exn)}} +;;> ] + +;;> Return the kind, message, and irritants +;;> associated with @var{exn} respectively. + +;;> @subsubsubsection{Lambdas} + +;;> @itemlist[ +;;> @item{@scheme{(lambda-name lam)} - the name of the lambda, if known} +;;> @item{@scheme{(lambda-name-set! lam x)}} +;;> @item{@scheme{(lambda-params lam)} - the lambda parameter list} +;;> @item{@scheme{(lambda-params-set! lam x)}} +;;> @item{@scheme{(lambda-body lam)} - the body of the lambda} +;;> @item{@scheme{(lambda-body-set! lam x)}} +;;> @item{@scheme{(lambda-defs lam)} - internal definitions of the lambda} +;;> @item{@scheme{(lambda-defs-set! lam x)}} +;;> @item{@scheme{(lambda-locals lam)} - local variables as a list of identifiers} +;;> @item{@scheme{(lambda-locals-set! lam x)}} +;;> @item{@scheme{(lambda-flags lam)} - various flags describing the lambda} +;;> @item{@scheme{(lambda-flags-set! lam x)}} +;;> @item{@scheme{(lambda-free-vars lam)} - free variables the lambda will need to close over} +;;> @item{@scheme{(lambda-free-vars-set! lam x)}} +;;> @item{@scheme{(lambda-set-vars lam)} - variables the lambda mutates} +;;> @item{@scheme{(lambda-set-vars-set! lam x)}} +;;> @item{@scheme{(lambda-return-type lam)} - the return type of the lambda} +;;> @item{@scheme{(lambda-return-type-set! lam x)}} +;;> @item{@scheme{(lambda-param-types lam)} - the types of the input parameters} +;;> @item{@scheme{(lambda-param-types-set! lam x)}} +;;> @item{@scheme{(lambda-source lam)} - the source code of the lambda} +;;> @item{@scheme{(lambda-source-set! lam x)}} +;;> ] + +;;> @subsubsubsection{Conditionals} + +;;> @itemlist[ +;;> @item{@scheme{(cnd-test cnd)} - the test for the conditional} +;;> @item{@scheme{(cnd-test-set! cnd x)}} +;;> @item{@scheme{(cnd-pass cnd)} - the success branch} +;;> @item{@scheme{(cnd-pass-set! cnd x)}} +;;> @item{@scheme{(cnd-fail cnd)} - the failure branch} +;;> @item{@scheme{(cnd-fail-set! cnd x)}} +;;> ] + +;;> @subsubsubsection{Sequences} + +;;> @itemlist[ +;;> @item{@scheme{(seq-ls seq)} - the list of sequence expressions} +;;> @item{@scheme{(seq-ls-set! seq x)}} +;;> ] + +;;> @subsubsubsection{References} + +;;> @itemlist[ +;;> @item{@scheme{(ref-name ref)} - the name of the referenced variable} +;;> @item{@scheme{(ref-name-set! ref x)}} +;;> @item{@scheme{(ref-cell ref)} - the environment cell the reference resolves to} +;;> @item{@scheme{(ref-cell-set! ref x)}} +;;> ] + +;;> @subsubsubsection{Mutations} + +;;> @itemlist[ +;;> @item{@scheme{(set-var set)} - a reference to the mutated variable} +;;> @item{@scheme{(set-var-set! set x)}} +;;> @item{@scheme{(set-value set)} - the value to set the variable to} +;;> @item{@scheme{(set-value-set! set x)}} +;;> ] + +;;> @subsubsubsection{Literals} + +;;> @itemlist[ +;;> @item{@scheme{(lit-value lit)} - the literal value} +;;> @item{@scheme{(lit-value-set! lit x)}} +;;> ] + +;;> @subsubsubsection{Pairs} + +;;> @itemlist[ +;;> @item{@scheme{(pair-source x)}} +;;> @item{@scheme{(pair-source-set! x source)}} +;;> ] + +;;> Set or return the source code info associated with a pair x. +;;> Source info is represented as another pair whose @var{car} is +;;> the source file name and whose @var{cdr} is the line number. + +;;> @subsubsection{Miscellaneous Utilities} + +;;> @subsubsubsection{@scheme{(gc)}} + +;;> Force a garbage collection. + +;;> @subsubsubsection{@scheme{(object-size x)}} + +;;> Returns the heap space directly used by @var{x}, not +;;> counting any elements of @var{x}. + +;;> @subsubsubsection{@scheme{(integer->immediate n)}} + +;;> Returns the interpretation of the integer @var{n} as +;;> an immediate object, useful for debugging. + +;;> @subsubsubsection{@scheme{(string-contains str pat)}} + +;;> Returns the first string cursor of @var{pat} in @var{str}, +;;> of @scheme{#f} if it's not found. diff --git a/lib/chibi/disasm.module b/lib/chibi/disasm.module index 84444591..a434fe98 100644 --- a/lib/chibi/disasm.module +++ b/lib/chibi/disasm.module @@ -1,4 +1,9 @@ +;;> @subsubsubsection{(disasm f [out])} + +;;> Write a human-readable disassembly for the procedure @var{f} to +;;> the port @var{out}, defaulting to @scheme{(current-output-port)}. + (module (chibi disasm) (export disasm) (import-immutable (scheme)) diff --git a/lib/chibi/equiv.scm b/lib/chibi/equiv.scm index d0b2651d..ee6f073e 100644 --- a/lib/chibi/equiv.scm +++ b/lib/chibi/equiv.scm @@ -1,4 +1,9 @@ +;;> Cycle-aware equality. Returns @scheme{#t} iff @scheme{a} and +;;> @scheme{b} are @scheme{equal?}, including cycles. Another way +;;> to think of it is they are @scheme{equiv} if they print the +;;> same, assuming all elements can be printed. + (define (equiv? a b) (let ((equivs (make-hash-table eq?))) (define (get-equivs x) diff --git a/lib/chibi/filesystem.module b/lib/chibi/filesystem.module index 57d487ba..eab98409 100644 --- a/lib/chibi/filesystem.module +++ b/lib/chibi/filesystem.module @@ -1,4 +1,9 @@ +;;> Interface to the filesystem and file descriptor objects. +;;> Note that file descriptors are currently represented as +;;> integers, but may be replaced with opaque (and gc-managed) +;;> objects in a future release. + (module (chibi filesystem) (export open-input-file-descriptor open-output-file-descriptor duplicate-file-descriptor duplicate-file-descriptor-to diff --git a/lib/chibi/filesystem.scm b/lib/chibi/filesystem.scm index aa3fc69f..bae76556 100644 --- a/lib/chibi/filesystem.scm +++ b/lib/chibi/filesystem.scm @@ -1,19 +1,28 @@ ;; filesystem.scm -- additional filesystem utilities -;; Copyright (c) 2009 Alex Shinn. All rights reserved. +;; Copyright (c) 2009-2011 Alex Shinn. All rights reserved. ;; BSD-style license: http://synthcode.com/license.txt +;;> The fundamental directory iterator. Applies @var{kons} to +;;> each filename in directory @var{dir} and the result of the +;;> previous application, beginning with @var{knil}. With +;;> @var{kons} as @scheme{cons} and @var{knil} as @scheme{'()}, +;;> equivalent to @scheme{directory-files}. + (define (directory-fold dir kons knil) (let ((dir (opendir dir))) (let lp ((res knil)) (let ((file (readdir dir))) (if file (lp (kons (dirent-name file) res)) res))))) +;;> Returns a list of the files in @var{dir} in an unspecified +;;> order. + (define (directory-files dir) (directory-fold dir cons '())) -(define (renumber-file-descriptor old new) - (and (duplicate-file-descriptor-to old new) - (close-file-descriptor old))) +;;> Returns the @scheme{status} object for the given @var{file}, +;;> which should be a string indicating the path or a file +;;> descriptor. (define (file-status file) (if (string? file) (stat file) (fstat file))) @@ -32,6 +41,10 @@ (define (file-modification-time x) (stat-mtime (if (stat? x) x (file-status x)))) (define (file-change-time x) (stat-ctime (if (stat? x) x (file-status x)))) +;;> File status accessors. @var{x} should be a string indicating +;;> the file to lookup the status for, or an existing status object. +;;/ + (define (file-regular? x) (S_ISREG (file-mode x))) (define (file-directory? x) (S_ISDIR (file-mode x))) (define (file-character? x) (S_ISCHR (file-mode x))) @@ -39,5 +52,17 @@ (define (file-fifo? x) (S_ISFIFO (file-mode x))) (define (file-link? x) (S_ISLNK (file-mode x))) (define (file-socket? x) (S_ISSOCK (file-mode x))) - (define (file-exists? x) (and (file-status x) #t)) + +;;> File type tests. @var{x} should be a string indicating the +;;> file to lookup the status for, or an existing status object. +;;> Returns @scheme{#t} if the file exists and the given type +;;> is satisfied, and @scheme{#f} otherwise. +;;/ + +;;> Equivalent to duplicating the file descriptor @var{old} to +;;> @var{new} and closing @var{old}. + +(define (renumber-file-descriptor old new) + (and (duplicate-file-descriptor-to old new) + (close-file-descriptor old))) diff --git a/lib/chibi/filesystem.stub b/lib/chibi/filesystem.stub index 2aa66e50..f934779c 100644 --- a/lib/chibi/filesystem.stub +++ b/lib/chibi/filesystem.stub @@ -1,3 +1,6 @@ +;; filesystem.stub -- filesystem bindings +;; Copyright (c) 2009-2011 Alex Shinn. All rights reserved. +;; BSD-style license: http://synthcode.com/license.txt (c-system-include "sys/types.h") (c-system-include "unistd.h") @@ -62,30 +65,79 @@ (define-c errno fstat (int (result stat))) (define-c errno (file-link-status "lstat") (string (result stat))) +;;> Creates a new input-port from the file descriptor @var{int}. + (define-c input-port (open-input-file-descriptor "fdopen") (int (value "r" string))) + +;;> Creates a new output-port from the file descriptor @var{int}. + (define-c output-port (open-output-file-descriptor "fdopen") (int (value "w" string))) +;;> Unlinks the file named @var{string} from the filesystem. +;;> Returns @scheme{#t} on success and @scheme{#f} on failure. + (define-c errno (delete-file "unlink") (string)) + +;;> Creates a hard link to the first arg from the second. +;;> Returns @scheme{#t} on success and @scheme{#f} on failure. + (define-c errno (link-file "link") (string string)) + +;;> Creates a symbolic link to the first arg from the second. +;;> Returns @scheme{#t} on success and @scheme{#f} on failure. + (define-c errno (symbolic-link-file "symlink") (string string)) + +;;> Renames the first arg to the second. +;;> Returns @scheme{#t} on success and @scheme{#f} on failure. + (define-c errno (rename-file "rename") (string string)) +;;> Returns the current working directory of the process as a string. + (define-c non-null-string (current-directory "getcwd") ((result (array char (auto-expand arg1))) (value 256 int))) +;;> Creates a new directory with the given mode. +;;> Returns @scheme{#t} on success and @scheme{#f} on failure. + (define-c errno (create-directory "mkdir") (string int)) + +;;> Deletes the directory named @var{string} from the filesystem. +;;> Does not attempt to delete recursively. +;;> Returns @scheme{#t} on success and @scheme{#f} on failure. + (define-c errno (delete-directory "rmdir") (string)) (define-c (free DIR) opendir (string)) (define-c dirent readdir ((link (pointer DIR)))) +;;> Duplicates the given file descriptor, returning he new value, +;; or -1 on failure. + (define-c int (duplicate-file-descriptor "dup") (int)) + +;;> Copies the first file descriptor to the second, closing +;;> it if needed. +;;> Returns @scheme{#t} on success and @scheme{#f} on failure. + (define-c errno (duplicate-file-descriptor-to "dup2") (int int)) + +;;> Closes the given file descriptor. +;;> Returns @scheme{#t} on success and @scheme{#f} on failure. + (define-c errno (close-file-descriptor "close") (int)) +;;> Returns a list of 2 new file descriptors, the input and +;;> output end of a new pipe, respectively. + (define-c errno (open-pipe "pipe") ((result (array int 2)))) + +;;> Creates a new named pipe in the given path. +;;> Returns @scheme{#t} on success and @scheme{#f} on failure. + (define-c errno (make-fifo "mkfifo") (string (default #o644 int))) (define-c int (get-file-descriptor-flags "fcntl") @@ -93,11 +145,17 @@ (define-c errno (set-file-descriptor-flags! "fcntl") (int (value F_SETFD int) long)) +;;> Get and set the flags for the given file descriptor. +;;/ + (define-c int (get-file-descriptor-status "fcntl") (int (value F_GETFL int))) (define-c errno (set-file-descriptor-status! "fcntl") (int (value F_SETFL int) long)) +;;> Get and set the status for the given file descriptor. +;;/ + ;; (define-c int (get-file-descriptor-lock "fcntl") ;; (int (value F_GETLK int) flock)) ;; (define-c errno (set-file-descriptor-lock! "fcntl") @@ -114,5 +172,10 @@ (define-c-const int (open/append "O_APPEND")) (define-c-const int (open/non-block "O_NONBLOCK")) -(define-c boolean (is-a-tty? "isatty") (port-or-fd)) +;;> File opening modes. +;;/ +;;> Returns @scheme{#t} if the given port of file descriptor +;;> if backed by a TTY object, and @scheme{#f} otherwise. + +(define-c boolean (is-a-tty? "isatty") (port-or-fd)) diff --git a/lib/chibi/generic.module b/lib/chibi/generic.module index 9dfcc2ba..bb438f68 100644 --- a/lib/chibi/generic.module +++ b/lib/chibi/generic.module @@ -1,4 +1,6 @@ +;;> Simple generic function interface. + (module (chibi generic) (export define-generic define-method make-generic generic-add!) (import-immutable (scheme)) diff --git a/lib/chibi/generic.scm b/lib/chibi/generic.scm index daaaac49..ea914de9 100644 --- a/lib/chibi/generic.scm +++ b/lib/chibi/generic.scm @@ -1,9 +1,12 @@ +;;> Define a new generic function named @var{name}. + (define-syntax define-generic (syntax-rules () ((define-generic name) (define name (make-generic 'name))))) +;; call-next-method needs to be unhygienic '(define-syntax define-method (syntax-rules () ((define-method (name (param type) ...) . body) @@ -13,6 +16,11 @@ (let-syntax ((call)) . body)))))) +;;> @subsubsubsection{(define-method (name (param type) ...) body ...)} + +;;> Extends the generic function @var{name} with a new method that +;;> applies when the given param types all match. + (define-syntax define-method (er-macro-transformer (lambda (e r c) @@ -38,6 +46,8 @@ (define add-method-tag (list 'add-method-tag)) +;;> Create a new first-class generic function named @var{name}. + (define (make-generic name) (let ((name name) (methods (make-vector 6 '()))) @@ -75,5 +85,9 @@ (vector-set! res plen (cons (cons preds f) (vector-ref res plen))) res))) +;;> Extend the generic @var{g} with a new method @var{f} +;;> that applies when all parameters match the given list +;;> of predicates @var{preds}. + (define (generic-add! g preds f) (g add-method-tag preds f)) diff --git a/lib/chibi/heap-stats.module b/lib/chibi/heap-stats.module index 408f3755..235399e4 100644 --- a/lib/chibi/heap-stats.module +++ b/lib/chibi/heap-stats.module @@ -1,4 +1,23 @@ +;;> Utilities for gathering statistics on the heap. Just measuring +;;> runtime memory usage doesn't give a good idea of how to optimize +;;> that usage, so this module is provided for profiling. + +;;> @subsubsubsection{(heap-stats)} + +;;> Returns an alist summarizing all heap allocated objects. The +;;> @var{car} of each cell is the type-name, and the @var{cdr} is the +;;> count of objects of that type in the heap. Garbage is collected +;;> before the counts are taken. + +;;> @subsubsubsection{(heap-dump [depth])} + +;;> Returns the same value as @scheme{(heap-stats)}, but also prints +;;> all objects on the heap as it runs. @var{depth} indicates the +;;> printing depth for compound objects and defaults to 1. + +;;> These functions just return @scheme{'()} when using the Boehm GC. + (module (chibi heap-stats) (export heap-stats heap-dump) (import-immutable (scheme)) diff --git a/lib/chibi/highlight.scm b/lib/chibi/highlight.scm index 9d8d4931..ffb8b545 100755 --- a/lib/chibi/highlight.scm +++ b/lib/chibi/highlight.scm @@ -2,6 +2,9 @@ ;; Copyright (c) 2011 Alex Shinn. All rights reserved. ;; BSD-style license: http://synthcode.com/license.txt +;;> Library for highlighting source code in different +;;> languages. Currently supports Scheme, C and Assembly. + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (string-concatenate-reverse ls) @@ -10,6 +13,18 @@ (define (reverse-list->string ls) (list->string (reverse ls))) +;;> Returns an sxml structure representing the code from source +;;> with various language constructs wrapped in highlighting +;;> forms. @var{source} should be a string or port. The +;;> language to highlight for is auto-detected. + +(define (highlight source) + (let ((str (if (string? source) source (port->string source)))) + ((highlighter-for (highlight-detect-language str)) str))) + +;;> Attempst to auto-detect which language @var{str} is code +;;> for, and returns a symbol representing that language. + (define (highlight-detect-language str) (cond ((guard (exn (else #f)) @@ -20,6 +35,8 @@ (else 'c))) +;;> Return a procedure for highlighting the given language. + (define (highlighter-for language) (case language ((scheme) highlight-scheme) @@ -27,10 +44,6 @@ ((none) (lambda (x) x)) (else highlight-c))) -(define (highlight source) - (let ((str (if (string? source) source (port->string source)))) - ((highlighter-for (highlight-detect-language str)) str))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define highlight-themes @@ -54,6 +67,11 @@ ;;'("#BAFFFF" "#FFCACA" "#FFFFBA" "#CACAFF" "#CAFFCA" "FFBAFF") '("#AAAAAA" "#888888" "#666666" "#444444" "#222222" "#000000")) +;;> Returns a string representing the CSS needed for the output +;;> of @var{highlight}. This should be included in a referenced +;;> CSS file, or in a @var{