documenting (chibi diff)

Makefile

@@ -46,14 +46,14 @@ COMPILED_LIBS = $(CHIBI_COMPILED_LIBS) $(CHIBI_IO_COMPILED_LIBS) \
 BASE_INCLUDES = include/chibi/sexp.h include/chibi/features.h include/chibi/install.h include/chibi/bignum.h
 INCLUDES = $(BASE_INCLUDES) include/chibi/eval.h include/chibi/gc_heap.h
 
-MODULE_DOCS := app ast config disasm equiv filesystem generic heap-stats io \
+MODULE_DOCS := app ast config diff disasm equiv filesystem generic heap-stats io \
 	loop match mime modules net net/http-server parse pathname process repl scribble stty \
 	system test time trace type-inference uri weak monad/environment \
-	show show/base crypto/sha2
+	crypto/sha2
 
 IMAGE_FILES = lib/chibi.img lib/red.img lib/snow.img
 
-HTML_LIBS = $(MODULE_DOCS:%=doc/lib/chibi/%.html)
+HTML_LIBS = $(MODULE_DOCS:%=doc/lib/chibi/%.html) doc/lib/srfi/166/base.html
 
 META_FILES = lib/.chibi.meta lib/.srfi.meta lib/.scheme.meta
 
@@ -493,6 +493,7 @@ snowballs:
 	$(SNOW_CHIBI) package lib/chibi/crypto/md5.sld
 	$(SNOW_CHIBI) package lib/chibi/crypto/rsa.sld
 	$(SNOW_CHIBI) package lib/chibi/crypto/sha2.sld
+	$(SNOW_CHIBI) package lib/chibi/diff.sld
 	$(SNOW_CHIBI) package lib/chibi/filesystem.sld
 	$(SNOW_CHIBI) package lib/chibi/math/prime.sld
 	$(SNOW_CHIBI) package lib/chibi/mime.sld

doc/chibi.scrbl

@@ -1266,6 +1266,8 @@ namespace.
 
 \item{\hyperlink["lib/chibi/config.html"]{(chibi config) - General configuration management}}
 
+\item{\hyperlink["lib/chibi/disasm.html"]{(chibi diff) - LCS Algorithm and diff utilities}}
+
 \item{\hyperlink["lib/chibi/disasm.html"]{(chibi disasm) - Disassembler for the virtual machine}}
 
 \item{\hyperlink["lib/chibi/equiv.html"]{(chibi equiv) - A version of \scheme{equal?} which is guaranteed to terminate}}
@@ -1302,8 +1304,6 @@ namespace.
 
 \item{\hyperlink["lib/chibi/show.html"]{(chibi show) - A combinator formatting library}}
 
-\item{\hyperlink["lib/chibi/show/base.scm"]{(chibi show base) - Base combinator formatting}}
-
 \item{\hyperlink["lib/chibi/stty.html"]{(chibi stty) - A high-level interface to ioctl}}
 
 \item{\hyperlink["lib/chibi/system.html"]{(chibi system) - Access to the host system and current user information}}

lib/chibi/diff-test.sld

@@ -5,6 +5,10 @@
   (begin
     (define (run-tests)
       (test-begin "diff")
+      (test '((#\A 1 0) (#\C 2 2))
+          (lcs-with-positions '(#\G #\A #\C) '(#\A #\G #\C #\A #\T)))
+      (test '(#\A #\C)
+          (lcs '(#\G #\A #\C) '(#\A #\G #\C #\A #\T)))
       (test '((#\G #\A #\C) (#\A #\G #\C #\A #\T) ((#\A 1 0) (#\C 2 2)))
           (diff "GAC" "AGCAT" read-char))
       (let ((d (diff "GAC" "AGCAT" read-char)))

lib/chibi/diff.scm

@@ -11,6 +11,19 @@
                   (loop a (cdr ls))
                   (loop b (cdr ls))))))))
 
+;;> Finds the Longest Common Subsequence between \var{a-ls} and
+;;> \var{b-ls}, comparing elements with \var{eq} (default
+;;> \scheme{equal?}.  Returns this sequence as a list, using the
+;;> elements from \var{a-ls}.  Uses quadratic time and space.
+(define (lcs a-ls b-ls . o)
+  (let ((eq (if (pair? o) (car o) equal?)))
+    (map car (lcs-with-positions a-ls b-ls eq))))
+
+;;> Variant of \scheme{lcs} which returns the annotated sequence.  The
+;;> result is a list of the common elements, each represented as a
+;;> list of 3 values: the element, the zero-indexed position in
+;;> \var{a-ls} where the element occurred, and the position in
+;;> \var{b-ls}.
 (define (lcs-with-positions a-ls b-ls . o)
   (let* ((eq (if (pair? o) (car o) equal?))
          (a-len (+ 1 (length a-ls)))
@@ -43,9 +56,6 @@
               res))))
     (cadr (vector-ref results 0))))
 
-(define (lcs a b . o)
-  (map car (cadr (lcs-with-positions a b (if (pair? o) (car o) equal?)))))
-
 (define (source->list x reader)
   (port->list
    reader
@@ -53,70 +63,28 @@
          ((string? x) (open-input-string x))
          (else (error "don't know how to diff from:" x)))))
 
-;; lcs on text, generates lists from ports (or strings)
+;;> Utility to run lcs on text.  \var{a} and \var{b} can be strings or
+;;> ports, which are tokenized into a sequence by calling \var{reader}
+;;> until \var{eof-object} is found.  Returns a list of three values,
+;;> the sequences read from \var{a} and \var{b}, and the \scheme{lcs}
+;;> result.
 (define (diff a b . o)
   (let-optionals o ((reader read-line)
-                    (equal equal?))
+                    (eq equal?))
     (let ((a-ls (source->list a reader))
           (b-ls (source->list b reader)))
-      (list a-ls b-ls (lcs-with-positions a-ls b-ls)))))
+      (list a-ls b-ls (lcs-with-positions a-ls b-ls eq)))))
-
-(define (write-line-diffs lines type out)
-  (for-each
-   (lambda (line)
-     (case type
-       ((add)
-        (write-char #\+ out))
-       ((remove)
-        (write-char #\- out))
-       ((same)
-        (write-char #\space out))
-       (else (error "unknown diff type:" type)))
-     (write-string line out)
-     (newline out))
-   lines))
-
-(define (write-line-diffs/color lines type out)
-  (for-each
-   (lambda (line)
-     (case type
-       ((add)
-        (write-string (green "+") out)
-        (write-string (green line) out))
-       ((remove)
-        (write-string (red "-") out)
-        (write-string (red line out)))
-       ((same)
-        (write-char #\space out)
-        (write-string line out))
-       (else (error "unknown diff type:" type)))
-     (newline out))
-   lines))
-
-(define (write-char-diffs chars type out)
-  (case type
-    ((add)
-     (write-string " «" out)
-     (write-string (list->string chars) out)
-     (write-string "» " out))
-    ((remove)
-     (write-string " »" out)
-     (write-string (list->string chars) out)
-     (write-string "« " out))
-    ((same)
-     (write-string (list->string chars) out))
-    (else (error "unknown diff type:" type))))
-
-(define (write-char-diffs/color chars type out)
-  (case type
-    ((add)
-     (write-string (green (list->string chars)) out))
-    ((remove)
-     (write-string (red (list->string chars)) out))
-    ((same)
-     (write-string (list->string chars) out))
-    (else (error "unknown diff type:" type))))
 
+;;> Utility to format the result of a \var{diff} to output port
+;;> \var{out} (default \scheme{(current-output-port)}).  Applies
+;;> \var{writer} to successive diff chunks.  \var{writer} should be a
+;;> procedure of three arguments: \scheme{(writer subsequence type
+;;> out).  \var{subsequence} is a subsequence from the original input,
+;;> \var{type} is a symbol indicating the type of diff: \scheme{'same}
+;;> if this is part of the lcs, \scheme{'add} if it is unique to the
+;;> second input, or \scheme{'remove} if it is unique to the first
+;;> input.  \var{writer} defaults to \scheme{write-line-diffs},
+;;> assuming the default line diffs.
 (define (write-diff diff . o)
   (let-optionals o ((writer write-line-diffs)
                     (out (current-output-port)))
@@ -144,11 +112,86 @@
               ;; recurse
               (lp (cdr d) a-tail a-off b-tail b-off))))))))
 
+;;> Equivalent to \scheme{write-diff} but collects the output to a string.
 (define (diff->string diff . o)
   (let ((out (open-output-string)))
     (write-diff diff (if (pair? o) (car o) write-line-diffs) out)
     (get-output-string out)))
 
+;;> The default writer for \scheme{write-diff}, annotates simple +/-
+;;> prefixes for added/removed lines.
+(define (write-line-diffs lines type out)
+  (for-each
+   (lambda (line)
+     (case type
+       ((add)
+        (write-char #\+ out))
+       ((remove)
+        (write-char #\- out))
+       ((same)
+        (write-char #\space out))
+       (else (error "unknown diff type:" type)))
+     (write-string line out)
+     (newline out))
+   lines))
+
+;;> A variant of \scheme{write-line-diffs} which adds red/green ANSI
+;;> coloring to the +/- prefix.
+(define (write-line-diffs/color lines type out)
+  (for-each
+   (lambda (line)
+     (case type
+       ((add)
+        (write-string (green "+") out)
+        (write-string (green line) out))
+       ((remove)
+        (write-string (red "-") out)
+        (write-string (red line out)))
+       ((same)
+        (write-char #\space out)
+        (write-string line out))
+       (else (error "unknown diff type:" type)))
+     (newline out))
+   lines))
+
+;;> A diff writer for sequences of characters (when a diff was
+;;> generated with \scheme{read-char}), enclosing added characters in
+;;> «...» brackets and removed characters in »...«.
+(define (write-char-diffs chars type out)
+  (case type
+    ((add)
+     (write-string " «" out)
+     (write-string (list->string chars) out)
+     (write-string "» " out))
+    ((remove)
+     (write-string " »" out)
+     (write-string (list->string chars) out)
+     (write-string "« " out))
+    ((same)
+     (write-string (list->string chars) out))
+    (else (error "unknown diff type:" type))))
+
+;;> A diff writer for sequences of characters (when a diff was
+;;> generated with \scheme{read-char}), formatting added characters in
+;;> green and removed characters in red.
+(define (write-char-diffs/color chars type out)
+  (case type
+    ((add)
+     (write-string (green (list->string chars)) out))
+    ((remove)
+     (write-string (red (list->string chars)) out))
+    ((same)
+     (write-string (list->string chars) out))
+    (else (error "unknown diff type:" type))))
+
+;;> Utility to format the result of a \scheme{diff} with respect to a
+;;> single input sequence \var{ls}. \var{lcs} is the annotated common
+;;> sequence from \scheme{diff} or \scheme{lcs-with-positions}, and
+;;> \var{index} is the index (0 or 1, default 1) of \var{ls} in the
+;;> original call.  Since we have no information about the other
+;;> input, we can only format what is the same and what is different,
+;;> formatting the differences as either added (if \var{index} is 0)
+;;> or removed (if \var{index} is 1).
 (define (write-edits ls lcs . o)
   (let-optionals o ((index 1)
                     (writer write-line-diffs)
@@ -172,6 +215,7 @@
          (else
           (lp (cdr ls) lcs (output (car ls) type) (+ i 1))))))))
 
+;;> Equivalent to \scheme{write-edits} but collects the output to a string.
 (define (edits->string ls lcs . o)
   (let-optionals o ((type 'add)
                     (writer (if (and (pair? ls) (char? (car ls)))
@@ -181,6 +225,10 @@
       (write-edits ls lcs type writer out)
       (get-output-string out))))
 
+;;> Equivalent to \scheme{write-edits} but collects the output to a
+;;> string and uses a color-aware writer by default.  Note with a
+;;> character diff this returns the original input string as-is, with
+;;> only ANSI escapes indicating what changed.
 (define (edits->string/color ls lcs . o)
   (let-optionals o ((type 'add)
                     (writer (if (and (pair? ls) (char? (car ls)))