userdiff: add support for Scheme

Add a diff driver for Scheme-like languages which recognizes top level and local `define` forms, whether it is a function definition, binding, syntax definition or a user-defined `define-xyzzy` form. Also supports R6RS `library` forms, `module` forms along with class and struct declarations used in Racket (PLT Scheme). Alternate "def" syntax such as those in Gerbil Scheme are also supported, like defstruct, defsyntax and so on. The rationale for picking `define` forms for the hunk headers is because it is usually the only significant form for defining the structure of the program, and it is a common pattern for schemers to have local function definitions to hide their visibility, so it is not only the top level `define`'s that are of interest. Schemers also extend the language with macros to provide their own define forms (for example, something like a `define-test-suite`) which is also captured in the hunk header. Since it is common practice to extend syntax with variants of a form like `module+`, `class*` etc, those have been supported as well. The word regex is a best-effort attempt to conform to R7RS[1] valid identifiers, symbols and numbers. [1] https://small.r7rs.org/attachment/r7rs.pdf (section 2.1) Signed-off-by: Atharva Raykar <raykar.ath@gmail.com> Signed-off-by: Junio C Hamano <gitster@pobox.com>

Atharva Raykar committed Apr 8, 2021 at 14:44 UTC a43739031092f951674d783ad3bdcbd603281851
18 files changed +101
Documentation/gitattributes.txt
+2
@@ -845,6 +845,8 @@ patterns are available:
845
846 - `rust` suitable for source code in the Rust language.
847
848 +- `scheme` suitable for source code in the Scheme language.
849 +
850 - `tex` suitable for source code for LaTeX documents.
851
852
t/t4018-diff-funcname.sh
+1
@@ -48,6 +48,7 @@ diffpatterns="
48 python
49 ruby
50 rust
51 + scheme
52 tex
53 custom1
54 custom2
t/t4018/scheme-class new
+7
@@ -0,0 +1,7 @@
1 +(define book-class%
2 + (class* () object% RIGHT
3 + (field (pages 5))
4 + (field (ChangeMe 5))
5 + (define/public (letters)
6 + (* pages 500))
7 + (super-new)))
t/t4018/scheme-def new
+4
@@ -0,0 +1,4 @@
1 +(def (some-func x y z) RIGHT
2 + (let ((a x)
3 + (b y))
4 + (ChangeMe a b)))
t/t4018/scheme-def-variant new
+4
@@ -0,0 +1,4 @@
1 +(defmethod {print point} RIGHT
2 + (lambda (self)
3 + (with ((point x y) self)
4 + (printf "{ChangeMe x:~a y:~a}~n" x y))))
t/t4018/scheme-define-slash-public new
+7
@@ -0,0 +1,7 @@
1 +(define bar-class%
2 + (class object%
3 + (field (info 5))
4 + (define/public (foo) RIGHT
5 + (+ info 42)
6 + (* info ChangeMe))
7 + (super-new)))
t/t4018/scheme-define-syntax new
+8
@@ -0,0 +1,8 @@
1 +(define-syntax define-test-suite RIGHT
2 + (syntax-rules ()
3 + ((_ suite-name (name test) ChangeMe ...)
4 + (define suite-name
5 + (let ((tests
6 + `((name . ,test) ...)))
7 + (lambda ()
8 + (run-suite 'suite-name tests)))))))
t/t4018/scheme-define-variant new
+4
@@ -0,0 +1,4 @@
1 +(define* (some-func x y z) RIGHT
2 + (let ((a x)
3 + (b y))
4 + (ChangeMe a b)))
t/t4018/scheme-library new
+11
@@ -0,0 +1,11 @@
1 +(library (my-helpers id-stuff) RIGHT
2 + (export find-dup)
3 + (import (ChangeMe))
4 + (define (find-dup l)
5 + (and (pair? l)
6 + (let loop ((rest (cdr l)))
7 + (cond
8 + [(null? rest) (find-dup (cdr l))]
9 + [(bound-identifier=? (car l) (car rest))
10 + (car rest)]
11 + [else (loop (cdr rest))])))))
t/t4018/scheme-local-define new
+4
@@ -0,0 +1,4 @@
1 +(define (higher-order)
2 + (define local-function RIGHT
3 + (lambda (x)
4 + (car "this is" "ChangeMe"))))
t/t4018/scheme-module new
+6
@@ -0,0 +1,6 @@
1 +(module A RIGHT
2 + (export with-display-exception)
3 + (extern (display-exception display-exception ChangeMe))
4 + (def (with-display-exception thunk)
5 + (with-catch (lambda (e) (display-exception e (current-error-port)) e)
6 + thunk)))
t/t4018/scheme-top-level-define new
+4
@@ -0,0 +1,4 @@
1 +(define (some-func x y z) RIGHT
2 + (let ((a x)
3 + (b y))
4 + (ChangeMe a b)))
t/t4018/scheme-user-defined-define new
+6
@@ -0,0 +1,6 @@
1 +(define-test-suite record\ case-tests RIGHT
2 + (record-case-1 (lambda (fail)
3 + (let ((a (make-foo 1 2)))
4 + (record-case a
5 + ((bar x) (ChangeMe))
6 + ((foo a b) (+ a b)))))))
t/t4034-diff-words.sh
+1
@@ -325,6 +325,7 @@ test_language_driver perl
325 test_language_driver php
326 test_language_driver python
327 test_language_driver ruby
328 +test_language_driver scheme
329 test_language_driver tex
330
331 test_expect_success 'word-diff with diff.sbe' '
t/t4034/scheme/expect new
+11
@@ -0,0 +1,11 @@
1 +<BOLD>diff --git a/pre b/post<RESET>
2 +<BOLD>index 74b6605..63b6ac4 100644<RESET>
3 +<BOLD>--- a/pre<RESET>
4 +<BOLD>+++ b/post<RESET>
5 +<CYAN>@@ -1,6 +1,6 @@<RESET>
6 +(define (<RED>myfunc a b<RESET><GREEN>my-func first second<RESET>)
7 + ; This is a <RED>really<RESET><GREEN>(moderately)<RESET> cool function.
8 + (<RED>this\place<RESET><GREEN>that\place<RESET> (+ 3 4))
9 + (define <RED>some-text<RESET><GREEN>|a greeting|<RESET> "hello")
10 + (let ((c (<RED>+ a b<RESET><GREEN>add1 first<RESET>)))
11 + (format "one more than the total is %d" (<RED>add1<RESET><GREEN>+<RESET> c <GREEN>second<RESET>))))
t/t4034/scheme/post new
+6
@@ -0,0 +1,6 @@
1 +(define (my-func first second)
2 + ; This is a (moderately) cool function.
3 + (that\place (+ 3 4))
4 + (define |a greeting| "hello")
5 + (let ((c (add1 first)))
6 + (format "one more than the total is %d" (+ c second))))
t/t4034/scheme/pre new
+6
@@ -0,0 +1,6 @@
1 +(define (myfunc a b)
2 + ; This is a really cool function.
3 + (this\place (+ 3 4))
4 + (define some-text "hello")
5 + (let ((c (+ a b)))
6 + (format "one more than the total is %d" (add1 c))))
userdiff.c
+9
@@ -191,6 +191,15 @@ PATTERNS("rust",
191 "[a-zA-Z_][a-zA-Z0-9_]*"
192 "|[0-9][0-9_a-fA-Fiosuxz]*(\\.([0-9]*[eE][+-]?)?[0-9_fF]*)?"
193 "|[-+*\\/<>%&^|=!:]=|<<=?|>>=?|&&|\\|\\||->|=>|\\.{2}=|\\.{3}|::"),
194 +PATTERNS("scheme",
195 + "^[\t ]*(\\(((define|def(struct|syntax|class|method|rules|record|proto|alias)?)[-*/ \t]|(library|module|struct|class)[*+ \t]).*)$",
196 + /*
197 + * R7RS valid identifiers include any sequence enclosed
198 + * within vertical lines having no backslashes
199 + */
200 + "\\|([^\\\\]*)\\|"
201 + /* All other words should be delimited by spaces or parentheses */
202 + "|([^][)(}{[ \t])+"),
203 PATTERNS("bibtex", "(@[a-zA-Z]{1,}[ \t]*\\{{0,1}[ \t]*[^ \t\"@',\\#}{~%]*).*$",
204 "[={}\"]|[^={}\" \t]+"),
205 PATTERNS("tex", "^(\\\\((sub)*section|chapter|part)\\*{0,1}\\{.*)$",