From 9fd9b886609c00e66efa0968855d477cbacbfe7f Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Thu, 23 Jul 2020 17:50:00 +0900 Subject: [PATCH] documenting (chibi diff) --- Makefile | 7 +- doc/chibi.scrbl | 4 +- lib/chibi/diff-test.sld | 4 + lib/chibi/diff.scm | 172 +++++++++++++++++++++++++--------------- 4 files changed, 120 insertions(+), 67 deletions(-) diff --git a/Makefile b/Makefile index 6caa1aa5..8e56b85f 100644 --- a/Makefile +++ b/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 diff --git a/doc/chibi.scrbl b/doc/chibi.scrbl index b7b015ae..f3d5f56c 100755 --- a/doc/chibi.scrbl +++ b/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}} diff --git a/lib/chibi/diff-test.sld b/lib/chibi/diff-test.sld index 866441f2..0d882ae3 100644 --- a/lib/chibi/diff-test.sld +++ b/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))) diff --git a/lib/chibi/diff.scm b/lib/chibi/diff.scm index f461d599..ed7607eb 100644 --- a/lib/chibi/diff.scm +++ b/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))))) - -(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)))) + (list a-ls b-ls (lcs-with-positions a-ls b-ls eq))))) +;;> 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)))