git@vger.kernel.org mailing list mirror (one of many)
 help / color / mirror / code / Atom feed
From: Atharva Raykar <raykar.ath@gmail.com>
To: git@vger.kernel.org
Cc: Atharva Raykar <raykar.ath@gmail.com>
Subject: [GSoC][PATCH v3 1/1] userdiff: add support for Scheme
Date: Thu,  8 Apr 2021 14:44:43 +0530	[thread overview]
Message-ID: <20210408091442.22740-2-raykar.ath@gmail.com> (raw)
In-Reply-To: <20210403131612.97194-1-raykar.ath@gmail.com>

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>
---
 Documentation/gitattributes.txt    |  2 ++
 t/t4018-diff-funcname.sh           |  1 +
 t/t4018/scheme-class               |  7 +++++++
 t/t4018/scheme-def                 |  4 ++++
 t/t4018/scheme-def-variant         |  4 ++++
 t/t4018/scheme-define-slash-public |  7 +++++++
 t/t4018/scheme-define-syntax       |  8 ++++++++
 t/t4018/scheme-define-variant      |  4 ++++
 t/t4018/scheme-library             | 11 +++++++++++
 t/t4018/scheme-local-define        |  4 ++++
 t/t4018/scheme-module              |  6 ++++++
 t/t4018/scheme-top-level-define    |  4 ++++
 t/t4018/scheme-user-defined-define |  6 ++++++
 t/t4034-diff-words.sh              |  1 +
 t/t4034/scheme/expect              | 11 +++++++++++
 t/t4034/scheme/post                |  6 ++++++
 t/t4034/scheme/pre                 |  6 ++++++
 userdiff.c                         |  9 +++++++++
 18 files changed, 101 insertions(+)
 create mode 100644 t/t4018/scheme-class
 create mode 100644 t/t4018/scheme-def
 create mode 100644 t/t4018/scheme-def-variant
 create mode 100644 t/t4018/scheme-define-slash-public
 create mode 100644 t/t4018/scheme-define-syntax
 create mode 100644 t/t4018/scheme-define-variant
 create mode 100644 t/t4018/scheme-library
 create mode 100644 t/t4018/scheme-local-define
 create mode 100644 t/t4018/scheme-module
 create mode 100644 t/t4018/scheme-top-level-define
 create mode 100644 t/t4018/scheme-user-defined-define
 create mode 100644 t/t4034/scheme/expect
 create mode 100644 t/t4034/scheme/post
 create mode 100644 t/t4034/scheme/pre

diff --git a/Documentation/gitattributes.txt b/Documentation/gitattributes.txt
index 0a60472bb5..cfcfa800c2 100644
--- a/Documentation/gitattributes.txt
+++ b/Documentation/gitattributes.txt
@@ -845,6 +845,8 @@ patterns are available:
 
 - `rust` suitable for source code in the Rust language.
 
+- `scheme` suitable for source code in the Scheme language.
+
 - `tex` suitable for source code for LaTeX documents.
 
 
diff --git a/t/t4018-diff-funcname.sh b/t/t4018-diff-funcname.sh
index 9675bc17db..823ea96acb 100755
--- a/t/t4018-diff-funcname.sh
+++ b/t/t4018-diff-funcname.sh
@@ -48,6 +48,7 @@ diffpatterns="
 	python
 	ruby
 	rust
+	scheme
 	tex
 	custom1
 	custom2
diff --git a/t/t4018/scheme-class b/t/t4018/scheme-class
new file mode 100644
index 0000000000..e5e07b43fb
--- /dev/null
+++ b/t/t4018/scheme-class
@@ -0,0 +1,7 @@
+(define book-class%
+  (class* () object% RIGHT
+    (field (pages 5))
+    (field (ChangeMe 5))
+    (define/public (letters)
+      (* pages 500))
+    (super-new)))
diff --git a/t/t4018/scheme-def b/t/t4018/scheme-def
new file mode 100644
index 0000000000..1e2673da96
--- /dev/null
+++ b/t/t4018/scheme-def
@@ -0,0 +1,4 @@
+(def (some-func x y z) RIGHT
+  (let ((a x)
+        (b y))
+        (ChangeMe a b)))
diff --git a/t/t4018/scheme-def-variant b/t/t4018/scheme-def-variant
new file mode 100644
index 0000000000..d857a61d64
--- /dev/null
+++ b/t/t4018/scheme-def-variant
@@ -0,0 +1,4 @@
+(defmethod {print point} RIGHT
+  (lambda (self)
+    (with ((point x y) self)
+      (printf "{ChangeMe x:~a y:~a}~n" x y))))
diff --git a/t/t4018/scheme-define-slash-public b/t/t4018/scheme-define-slash-public
new file mode 100644
index 0000000000..39a93a1600
--- /dev/null
+++ b/t/t4018/scheme-define-slash-public
@@ -0,0 +1,7 @@
+(define bar-class%
+  (class object%
+    (field (info 5))
+    (define/public (foo) RIGHT
+      (+ info 42)
+      (* info ChangeMe))
+    (super-new)))
diff --git a/t/t4018/scheme-define-syntax b/t/t4018/scheme-define-syntax
new file mode 100644
index 0000000000..7d5e99e0fc
--- /dev/null
+++ b/t/t4018/scheme-define-syntax
@@ -0,0 +1,8 @@
+(define-syntax define-test-suite RIGHT
+  (syntax-rules ()
+    ((_ suite-name (name test) ChangeMe ...)
+     (define suite-name
+       (let ((tests
+              `((name . ,test) ...)))
+         (lambda ()
+           (run-suite 'suite-name tests)))))))
diff --git a/t/t4018/scheme-define-variant b/t/t4018/scheme-define-variant
new file mode 100644
index 0000000000..911708854d
--- /dev/null
+++ b/t/t4018/scheme-define-variant
@@ -0,0 +1,4 @@
+(define* (some-func x y z) RIGHT
+  (let ((a x)
+        (b y))
+        (ChangeMe a b)))
diff --git a/t/t4018/scheme-library b/t/t4018/scheme-library
new file mode 100644
index 0000000000..82ea3df510
--- /dev/null
+++ b/t/t4018/scheme-library
@@ -0,0 +1,11 @@
+(library (my-helpers id-stuff) RIGHT
+  (export find-dup)
+  (import (ChangeMe))
+  (define (find-dup l)
+    (and (pair? l)
+         (let loop ((rest (cdr l)))
+           (cond
+            [(null? rest) (find-dup (cdr l))]
+            [(bound-identifier=? (car l) (car rest))
+             (car rest)]
+            [else (loop (cdr rest))])))))
diff --git a/t/t4018/scheme-local-define b/t/t4018/scheme-local-define
new file mode 100644
index 0000000000..bc6d8aebbe
--- /dev/null
+++ b/t/t4018/scheme-local-define
@@ -0,0 +1,4 @@
+(define (higher-order)
+  (define local-function RIGHT
+    (lambda (x)
+     (car "this is" "ChangeMe"))))
diff --git a/t/t4018/scheme-module b/t/t4018/scheme-module
new file mode 100644
index 0000000000..edfae0ebf7
--- /dev/null
+++ b/t/t4018/scheme-module
@@ -0,0 +1,6 @@
+(module A RIGHT
+  (export with-display-exception)
+  (extern (display-exception display-exception ChangeMe))
+  (def (with-display-exception thunk)
+    (with-catch (lambda (e) (display-exception e (current-error-port)) e)
+      thunk)))
diff --git a/t/t4018/scheme-top-level-define b/t/t4018/scheme-top-level-define
new file mode 100644
index 0000000000..624743c22b
--- /dev/null
+++ b/t/t4018/scheme-top-level-define
@@ -0,0 +1,4 @@
+(define (some-func x y z) RIGHT
+  (let ((a x)
+        (b y))
+        (ChangeMe a b)))
diff --git a/t/t4018/scheme-user-defined-define b/t/t4018/scheme-user-defined-define
new file mode 100644
index 0000000000..35fe7cc9bf
--- /dev/null
+++ b/t/t4018/scheme-user-defined-define
@@ -0,0 +1,6 @@
+(define-test-suite record\ case-tests RIGHT
+  (record-case-1 (lambda (fail)
+                   (let ((a (make-foo 1 2)))
+                     (record-case a
+                       ((bar x) (ChangeMe))
+                       ((foo a b) (+ a b)))))))
diff --git a/t/t4034-diff-words.sh b/t/t4034-diff-words.sh
index 56f1e62a97..ee7721ab91 100755
--- a/t/t4034-diff-words.sh
+++ b/t/t4034-diff-words.sh
@@ -325,6 +325,7 @@ test_language_driver perl
 test_language_driver php
 test_language_driver python
 test_language_driver ruby
+test_language_driver scheme
 test_language_driver tex
 
 test_expect_success 'word-diff with diff.sbe' '
diff --git a/t/t4034/scheme/expect b/t/t4034/scheme/expect
new file mode 100644
index 0000000000..496cd5de8c
--- /dev/null
+++ b/t/t4034/scheme/expect
@@ -0,0 +1,11 @@
+<BOLD>diff --git a/pre b/post<RESET>
+<BOLD>index 74b6605..63b6ac4 100644<RESET>
+<BOLD>--- a/pre<RESET>
+<BOLD>+++ b/post<RESET>
+<CYAN>@@ -1,6 +1,6 @@<RESET>
+(define (<RED>myfunc a b<RESET><GREEN>my-func first second<RESET>)
+  ; This is a <RED>really<RESET><GREEN>(moderately)<RESET> cool function.
+  (<RED>this\place<RESET><GREEN>that\place<RESET> (+ 3 4))
+  (define <RED>some-text<RESET><GREEN>|a greeting|<RESET> "hello")
+  (let ((c (<RED>+ a b<RESET><GREEN>add1 first<RESET>)))
+    (format "one more than the total is %d" (<RED>add1<RESET><GREEN>+<RESET> c <GREEN>second<RESET>))))
diff --git a/t/t4034/scheme/post b/t/t4034/scheme/post
new file mode 100644
index 0000000000..63b6ac4f87
--- /dev/null
+++ b/t/t4034/scheme/post
@@ -0,0 +1,6 @@
+(define (my-func first second)
+  ; This is a (moderately) cool function.
+  (that\place (+ 3 4))
+  (define |a greeting| "hello")
+  (let ((c (add1 first)))
+    (format "one more than the total is %d" (+ c second))))
diff --git a/t/t4034/scheme/pre b/t/t4034/scheme/pre
new file mode 100644
index 0000000000..74b6605357
--- /dev/null
+++ b/t/t4034/scheme/pre
@@ -0,0 +1,6 @@
+(define (myfunc a b)
+  ; This is a really cool function.
+  (this\place (+ 3 4))
+  (define some-text "hello")
+  (let ((c (+ a b)))
+    (format "one more than the total is %d" (add1 c))))
diff --git a/userdiff.c b/userdiff.c
index 3f81a2261c..3897317aff 100644
--- a/userdiff.c
+++ b/userdiff.c
@@ -191,6 +191,15 @@ PATTERNS("rust",
 	 "[a-zA-Z_][a-zA-Z0-9_]*"
 	 "|[0-9][0-9_a-fA-Fiosuxz]*(\\.([0-9]*[eE][+-]?)?[0-9_fF]*)?"
 	 "|[-+*\\/<>%&^|=!:]=|<<=?|>>=?|&&|\\|\\||->|=>|\\.{2}=|\\.{3}|::"),
+PATTERNS("scheme",
+	 "^[\t ]*(\\(((define|def(struct|syntax|class|method|rules|record|proto|alias)?)[-*/ \t]|(library|module|struct|class)[*+ \t]).*)$",
+	 /*
+	  * R7RS valid identifiers include any sequence enclosed
+	  * within vertical lines having no backslashes
+	  */
+	 "\\|([^\\\\]*)\\|"
+	 /* All other words should be delimited by spaces or parentheses */
+	 "|([^][)(}{[ \t])+"),
 PATTERNS("bibtex", "(@[a-zA-Z]{1,}[ \t]*\\{{0,1}[ \t]*[^ \t\"@',\\#}{~%]*).*$",
 	 "[={}\"]|[^={}\" \t]+"),
 PATTERNS("tex", "^(\\\\((sub)*section|chapter|part)\\*{0,1}\\{.*)$",
-- 
2.31.1


  parent reply	other threads:[~2021-04-08  9:16 UTC|newest]

Thread overview: 35+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2021-03-27 17:39 [GSOC][PATCH] userdiff: add support for Scheme Atharva Raykar
2021-03-27 22:50 ` Junio C Hamano
2021-03-27 23:09   ` Junio C Hamano
2021-03-28  3:16     ` Ævar Arnfjörð Bjarmason
2021-03-28  5:37       ` Junio C Hamano
2021-03-28 12:40       ` Atharva Raykar
2021-03-29 10:08         ` Phillip Wood
2021-03-30  6:41           ` Atharva Raykar
2021-03-30 12:56             ` Ævar Arnfjörð Bjarmason
2021-03-30 13:48               ` Atharva Raykar
2021-03-28 12:45     ` Atharva Raykar
2021-03-28 11:51   ` Atharva Raykar
2021-03-28 18:06     ` Junio C Hamano
2021-03-29  8:12       ` Atharva Raykar
2021-03-29 20:47         ` Junio C Hamano
2021-03-29 10:12     ` Phillip Wood
2021-03-27 23:46 ` Johannes Sixt
2021-03-28 12:23   ` Atharva Raykar
2021-03-29 10:18     ` Phillip Wood
2021-03-29 10:48       ` Johannes Sixt
2021-03-29 13:12         ` Ævar Arnfjörð Bjarmason
2021-03-29 14:06           ` Phillip Wood
2021-03-30  7:04       ` Atharva Raykar
2021-03-30 10:22         ` Atharva Raykar
2021-04-05 10:04           ` Phillip Wood
2021-04-05 17:58             ` Johannes Sixt
2021-04-06 12:29             ` Atharva Raykar
2021-04-06 19:10               ` Phillip Wood
2021-04-03 13:16 ` [GSoC][PATCH v2 0/1] userdiff: add support for scheme Atharva Raykar
2021-04-03 13:16   ` [GSoC][PATCH v2 1/1] " Atharva Raykar
2021-04-05 10:21     ` Phillip Wood
2021-04-06 10:32       ` Atharva Raykar
2021-04-08  9:14   ` [GSoC][PATCH v3 0/1] " Atharva Raykar
2021-04-08  9:14   ` Atharva Raykar [this message]
2021-04-12 23:04     ` [GSoC][PATCH v3 1/1] userdiff: add support for Scheme Junio C Hamano

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: http://vger.kernel.org/majordomo-info.html

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20210408091442.22740-2-raykar.ath@gmail.com \
    --to=raykar.ath@gmail.com \
    --cc=git@vger.kernel.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://80x24.org/mirrors/git.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).