add support for equal? on records #273

jcubic · Jan 16, 2024 · 64e6bf0 · 64e6bf0
1 parent 8d59366
commit 64e6bf0
Show file tree

Hide file tree

Showing 11 changed files with 49 additions and 16 deletions.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -9,6 +9,7 @@
 * add support to ES Modules [#254](https://github.com/jcubic/lips/issues/254)
 * add support for `(scheme-report-environment 7)`
 * add a way to compare custom instances with `equal?` [#270](https://github.com/jcubic/lips/issues/270)
+* add support for `equal?` on records [#273](https://github.com/jcubic/lips/issues/273)
 ### Bugfix
 * remove evaluating of async list data as first argument
 * fix `number->string` for binary numbers

diff --git a/README.md b/README.md
@@ -8,7 +8,7 @@
 [![npm](https://img.shields.io/badge/npm-1.0.0%E2%80%93beta.17.3-blue.svg)](https://www.npmjs.com/package/@jcubic/lips)
 ![1.0.0 Complete](https://img.shields.io/github/milestones/progress-percent/jcubic/lips/1?label=1.0.0%20Complete)
 [![Build and test](https://github.com/jcubic/lips/actions/workflows/build.yaml/badge.svg?branch=devel&event=push)](https://github.com/jcubic/lips/actions/workflows/build.yaml)
-[![Coverage Status](https://coveralls.io/repos/github/jcubic/lips/badge.svg?branch=devel&a3856ea567ed3ad8203dcd0e53c85edb)](https://coveralls.io/github/jcubic/lips?branch=devel)
+[![Coverage Status](https://coveralls.io/repos/github/jcubic/lips/badge.svg?branch=devel&f9d187f3e5e7714da90a616b472c4d99)](https://coveralls.io/github/jcubic/lips?branch=devel)
 [![Join Gitter Chat](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/jcubic/lips)
 ![NPM Download Count](https://img.shields.io/npm/dm/@jcubic/lips)
 ![JSDelivr Download count](https://img.shields.io/jsdelivr/npm/hm/@jcubic/lips)

diff --git a/dist/lips.esm.js b/dist/lips.esm.js
diff --git a/dist/lips.esm.min.js b/dist/lips.esm.min.js
diff --git a/dist/lips.js b/dist/lips.js
diff --git a/dist/lips.min.js b/dist/lips.min.js
diff --git a/dist/std.min.scm b/dist/std.min.scm
diff --git a/dist/std.scm b/dist/std.scm
diff --git a/dist/std.xcb b/dist/std.xcb
diff --git a/lib/R7RS.scm b/lib/R7RS.scm
@@ -1006,6 +1006,17 @@
                                                                                 name)))
                                                       `(set! ,(string->symbol prop) ,field)))
                                                   (cdr constructor))))
+                            (equal (lambda (self other)
+                                     (if (instanceof ,name other)
+                                         (and ,@(map (lambda (field)
+                                                       (let* ((name (symbol->string field))
+                                                              (self-prop (string-append "self."
+                                                                                        name))
+                                                              (other-prop (string-append "other."
+                                                                                         name)))
+                                                         `(equal? ,(string->symbol self-prop)
+                                                                  ,(string->symbol other-prop))))))
+                                         #f)))
                             (typeOf (lambda (self)
                                       "record"))
                             (toString (lambda (self)

diff --git a/tests/std.scm b/tests/std.scm
@@ -277,3 +277,13 @@
           (y kdr set-kdr!))
 
         (t.is (type (kons 1 2)) "record")))
+
+(test "std: equal? on records"
+      (lambda (t)
+        (define-record-type <pare>
+          (kons x y)
+          pare?
+          (x kar set-kar!)
+          (y kdr set-kdr!))
+
+        (t.is (kons 1 2) (kons 1 2))))