diff options
| -rw-r--r-- | users/wpcarro/emacs/default.nix | 4 | ||||
| -rw-r--r-- | users/wpcarro/emacs/pkgs/al/al.el (renamed from users/wpcarro/emacs/.emacs.d/wpc/al.el) | 37 | ||||
| -rw-r--r-- | users/wpcarro/emacs/pkgs/al/default.nix | 28 | ||||
| -rw-r--r-- | users/wpcarro/emacs/pkgs/al/tests.el | 34 | ||||
| -rw-r--r-- | users/wpcarro/emacs/pkgs/list/default.nix | 28 | ||||
| -rw-r--r-- | users/wpcarro/emacs/pkgs/list/list.el (renamed from users/wpcarro/emacs/.emacs.d/wpc/list.el) | 56 | ||||
| -rw-r--r-- | users/wpcarro/emacs/pkgs/list/tests.el | 32 | ||||
| -rw-r--r-- | users/wpcarro/emacs/pkgs/set/default.nix | 32 | ||||
| -rw-r--r-- | users/wpcarro/emacs/pkgs/set/set.el (renamed from users/wpcarro/emacs/.emacs.d/wpc/set.el) | 76 | ||||
| -rw-r--r-- | users/wpcarro/emacs/pkgs/set/tests.el | 78 | ||||
| -rw-r--r-- | users/wpcarro/emacs/pkgs/struct/default.nix | 29 | ||||
| -rw-r--r-- | users/wpcarro/emacs/pkgs/struct/struct.el (renamed from users/wpcarro/emacs/.emacs.d/wpc/struct.el) | 29 | ||||
| -rw-r--r-- | users/wpcarro/emacs/pkgs/struct/tests.el | 25 |
13 files changed, 323 insertions, 165 deletions
diff --git a/users/wpcarro/emacs/default.nix b/users/wpcarro/emacs/default.nix index 6607b668d5a5..ea70006e6fc7 100644 --- a/users/wpcarro/emacs/default.nix +++ b/users/wpcarro/emacs/default.nix @@ -25,6 +25,10 @@ let wpcarrosEmacs = emacsWithPackages (epkgs: (with wpcarro.emacs.pkgs; [ + al + list + set + struct zle ]) ++ diff --git a/users/wpcarro/emacs/.emacs.d/wpc/al.el b/users/wpcarro/emacs/pkgs/al/al.el index 3cf98fee296b..aa818941535f 100644 --- a/users/wpcarro/emacs/.emacs.d/wpc/al.el +++ b/users/wpcarro/emacs/pkgs/al/al.el @@ -65,10 +65,9 @@ ;; Dependencies: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(require 'macros) (require 'dash) -(require 'tuple) -(require 'maybe) +(require 'list) +(require 'map) ;; TODO: Support function aliases for: ;; - create/set @@ -85,13 +84,6 @@ ;; TODO: Consider wrapping all of this with `(cl-defstruct alist xs)'. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Constants -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst al-enable-tests? t - "When t, run the test suite.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Library ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -183,11 +175,11 @@ Mutative variant of `al-delete'." (defun al-has-key? (k xs) "Return t if XS has a key `equal' to K." - (maybe-some? (assoc k xs))) + (not (eq nil (assoc k xs)))) (defun al-has-value? (v xs) "Return t if XS has a value of V." - (maybe-some? (rassoc v xs))) + (not (eq nil (rassoc v xs)))) (defun al-count (xs) "Return the number of entries in XS." @@ -229,26 +221,5 @@ F should return a tuple. See tuple.el for more information." In this case, the last writer wins, which is B." (al-reduce a #'al-set b)) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Tests -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(when al-enable-tests? - (prelude-assert - (equal '((2 . one) - (3 . two)) - (al-map-keys #'1+ - '((1 . one) - (2 . two))))) - (prelude-assert - (equal '((one . 2) - (two . 3)) - (al-map-values #'1+ - '((one . 1) - (two . 2)))))) - - -;; TODO: Support test cases for the entire API. - (provide 'al) ;;; al.el ends here diff --git a/users/wpcarro/emacs/pkgs/al/default.nix b/users/wpcarro/emacs/pkgs/al/default.nix new file mode 100644 index 000000000000..d88e0757a875 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/al/default.nix @@ -0,0 +1,28 @@ +{ pkgs, depot, ... }: + +let + al = pkgs.callPackage + ({ emacsPackages }: + emacsPackages.trivialBuild { + pname = "al"; + version = "1.0.0"; + src = ./al.el; + packageRequires = + (with emacsPackages; [ + dash + ]) ++ + (with depot.users.wpcarro.emacs.pkgs; [ + list + ]); + }) + { }; + + emacs = (pkgs.emacsPackagesFor pkgs.emacs28).emacsWithPackages (epkgs: [ al ]); +in +al.overrideAttrs (_old: { + doCheck = true; + checkPhase = '' + ${emacs}/bin/emacs -batch \ + -l ert -l ${./tests.el} -f ert-run-tests-batch-and-exit + ''; +}) diff --git a/users/wpcarro/emacs/pkgs/al/tests.el b/users/wpcarro/emacs/pkgs/al/tests.el new file mode 100644 index 000000000000..5146ee6b21a4 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/al/tests.el @@ -0,0 +1,34 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'ert) +(require 'al) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(ert-deftest al-has-key? () + (and + (al-has-key? 'fname '((fname . "William"))) + (not (al-has-key? 'lname '((fname . "William")))))) + +(ert-deftest al-has-value? () + (and + (al-has-value? "William" '((fname . "William"))) + (not (al-has-key? "John" '((fname . "William")))))) + +(ert-deftest al-map-keys () + (equal '((2 . one) + (3 . two)) + (al-map-keys #'1+ + '((1 . one) + (2 . two))))) + +(ert-deftest al-map-values () + (equal '((one . 2) + (two . 3)) + (al-map-values #'1+ + '((one . 1) + (two . 2))))) diff --git a/users/wpcarro/emacs/pkgs/list/default.nix b/users/wpcarro/emacs/pkgs/list/default.nix new file mode 100644 index 000000000000..490c0ba1745b --- /dev/null +++ b/users/wpcarro/emacs/pkgs/list/default.nix @@ -0,0 +1,28 @@ +{ pkgs, depot, ... }: + +let + list = pkgs.callPackage + ({ emacsPackages }: + emacsPackages.trivialBuild { + pname = "list"; + version = "1.0.0"; + src = ./list.el; + packageRequires = + (with emacsPackages; [ + dash + ]) ++ + (with depot.users.wpcarro.emacs.pkgs; [ + set + ]); + }) + { }; + + emacs = (pkgs.emacsPackagesFor pkgs.emacs28).emacsWithPackages (epkgs: [ list ]); +in +list.overrideAttrs (_old: { + doCheck = true; + checkPhase = '' + ${emacs}/bin/emacs -batch \ + -l ert -l ${./tests.el} -f ert-run-tests-batch-and-exit + ''; +}) diff --git a/users/wpcarro/emacs/.emacs.d/wpc/list.el b/users/wpcarro/emacs/pkgs/list/list.el index 2f1509eeb4a9..836eee89ebf3 100644 --- a/users/wpcarro/emacs/.emacs.d/wpc/list.el +++ b/users/wpcarro/emacs/pkgs/list/list.el @@ -52,17 +52,8 @@ ;; Dependencies ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; TODO: Move `prelude-assert' elsewhere so that I can require it without -;; introducing the circular dependency of list.el -> prelude.el -> list.el. -;;(require 'prelude) (require 'dash) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Constants -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst list-tests? t - "When t, run the test suite.") +(require 'set) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Library @@ -154,6 +145,19 @@ "Return the first x in XS that passes P or nil." (-find p xs)) +;; TODO: Support dedupe. +;; TODO: Should we call this unique? Or distinct? + +;; TODO: Add tests. +(defun list-dedupe-adjacent (xs) + "Return XS without adjacent duplicates." + (list-reduce (list (list-first xs)) + (lambda (x acc) + (if (equal x (list-first acc)) + acc + (list-cons x acc))) + xs)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Predicates ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -185,37 +189,5 @@ Be leery of using this with things like alists. Many data structures in Elisp (= (length xs) (->> xs (-map f) set-from-list set-count))) -;; TODO: Support dedupe. -;; TODO: Should we call this unique? Or distinct? - -;; TODO: Add tests. -(defun list-dedupe-adjacent (xs) - "Return XS without adjacent duplicates." - (prelude-assert (not (list-empty? xs))) - (list-reduce (list (list-first xs)) - (lambda (x acc) - (if (equal x (list-first acc)) - acc - (list-cons x acc))) - xs)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Tests -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; (when list-tests? -;; (prelude-assert -;; (= 0 -;; (list-length '()))) -;; (prelude-assert -;; (= 5 -;; (list-length '(1 2 3 4 5)))) -;; (prelude-assert -;; (= 16 -;; (list-reduce 1 (lambda (x acc) (+ x acc)) '(1 2 3 4 5)))) -;; (prelude-assert -;; (equal '(2 4 6 8 10) -;; (list-map (lambda (x) (* x 2)) '(1 2 3 4 5))))) - (provide 'list) ;;; list.el ends here diff --git a/users/wpcarro/emacs/pkgs/list/tests.el b/users/wpcarro/emacs/pkgs/list/tests.el new file mode 100644 index 000000000000..2f7090d4676c --- /dev/null +++ b/users/wpcarro/emacs/pkgs/list/tests.el @@ -0,0 +1,32 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'ert) +(require 'list) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(ert-deftest list-length () + (= 0 (list-length '())) + (= 5 (list-length '(1 2 3 4 5)))) + +(ert-deftest list-reduce () + (= 16 (list-reduce 1 (lambda (x acc) (+ x acc)) '(1 2 3 4 5)))) + +(ert-deftest list-map () + (equal '(2 4 6 8 10) + (list-map (lambda (x) (* x 2)) '(1 2 3 4 5)))) + +(ert-deftest list-xs-distinct-by? () + (list-xs-distinct-by? + (lambda (x) (plist-get x :kbd)) + '((:kbd "C-a" [:name] "foo") + + (:kbd "C-b" :name "[]foo")))) + +(ert-deftest list-dedupe-adjacent () + (equal '(1 2 3 4 3 5) + (list-dedupe-adjacent '(1 1 1 2 2 3 4 4 3 5 5)))) diff --git a/users/wpcarro/emacs/pkgs/set/default.nix b/users/wpcarro/emacs/pkgs/set/default.nix new file mode 100644 index 000000000000..319ba9274423 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/set/default.nix @@ -0,0 +1,32 @@ +{ pkgs, depot, ... }: + +let + set = pkgs.callPackage + ({ emacsPackages }: + emacsPackages.trivialBuild { + pname = "set"; + version = "1.0.0"; + src = ./set.el; + packageRequires = + (with emacsPackages; [ + dash + ht + ]) ++ + (with depot.users.wpcarro.emacs.pkgs; [ + struct + ]); + }) + { }; + + emacs = (pkgs.emacsPackagesFor pkgs.emacs28).emacsWithPackages (epkgs: [ + epkgs.dash + set + ]); +in +set.overrideAttrs (_old: { + doCheck = true; + checkPhase = '' + ${emacs}/bin/emacs -batch \ + -l ert -l ${./tests.el} -f ert-run-tests-batch-and-exit + ''; +}) diff --git a/users/wpcarro/emacs/.emacs.d/wpc/set.el b/users/wpcarro/emacs/pkgs/set/set.el index 778b089e156b..2d6e14917a45 100644 --- a/users/wpcarro/emacs/.emacs.d/wpc/set.el +++ b/users/wpcarro/emacs/pkgs/set/set.el @@ -9,8 +9,13 @@ ;;; Code: +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'cl-lib) +(require 'dash) (require 'ht) ;; friendlier API for hash-tables -(require 'dotted) (require 'struct) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -27,13 +32,10 @@ (cl-defstruct set xs) -(defconst set-enable-testing? t - "Run tests when t.") - (defun set-from-list (xs) "Create a new set from the list XS." (make-set :xs (->> xs - (list-map #'dotted-new) + (-map (lambda (x) (cons x nil))) ht-from-alist))) (defun set-new (&rest args) @@ -61,7 +63,7 @@ "Return a new set by calling F on each element of XS and ACC." (->> xs set-to-list - (list-reduce acc f))) + (-reduce-from (lambda (acc x) (funcall f x acc)) acc))) (defun set-intersection (a b) "Return the set intersection between A and B." @@ -104,71 +106,11 @@ "Return t if A has all of the members of B." (->> b set-to-list - (list-all? (lambda (x) (set-contains? x a))))) + (-all? (lambda (x) (set-contains? x a))))) (defun set-subset? (a b) "Return t if each member of set A is present in set B." (set-superset? b a)) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Tests -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(when set-enable-testing? - ;; set-distinct? - (prelude-assert - (set-distinct? (set-new 'one 'two 'three) - (set-new 'a 'b 'c))) - (prelude-refute - (set-distinct? (set-new 1 2 3) - (set-new 3 4 5))) - (prelude-refute - (set-distinct? (set-new 1 2 3) - (set-new 1 2 3))) - ;; set-equal? - (prelude-refute - (set-equal? (set-new 'a 'b 'c) - (set-new 'x 'y 'z))) - (prelude-refute - (set-equal? (set-new 'a 'b 'c) - (set-new 'a 'b))) - (prelude-assert - (set-equal? (set-new 'a 'b 'c) - (set-new 'a 'b 'c))) - ;; set-intersection - (prelude-assert - (set-equal? (set-new 2 3) - (set-intersection (set-new 1 2 3) - (set-new 2 3 4)))) - ;; set-{from,to}-list - (prelude-assert (equal '(1 2 3) - (->> '(1 1 2 2 3 3) - set-from-list - set-to-list))) - (let ((primary-colors (set-new "red" "green" "blue"))) - ;; set-subset? - (prelude-refute - (set-subset? (set-new "black" "grey") - primary-colors)) - (prelude-assert - (set-subset? (set-new "red") - primary-colors)) - ;; set-superset? - (prelude-refute - (set-superset? primary-colors - (set-new "black" "grey"))) - (prelude-assert - (set-superset? primary-colors - (set-new "red" "green" "blue"))) - (prelude-assert - (set-superset? primary-colors - (set-new "red" "blue")))) - ;; set-empty? - (prelude-assert (set-empty? (set-new))) - (prelude-refute (set-empty? (set-new 1 2 3))) - ;; set-count - (prelude-assert (= 0 (set-count (set-new)))) - (prelude-assert (= 2 (set-count (set-new 1 1 2 2))))) - (provide 'set) ;;; set.el ends here diff --git a/users/wpcarro/emacs/pkgs/set/tests.el b/users/wpcarro/emacs/pkgs/set/tests.el new file mode 100644 index 000000000000..3544364897d2 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/set/tests.el @@ -0,0 +1,78 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'ert) +(require 'dash) +(require 'set) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(ert-deftest set-from-list () + (equal '(1 2 3) + (->> '(1 2 3 1 2 3) + set-from-list + set-to-list))) + +(ert-deftest set-distinct? () + (and + (set-distinct? (set-new 'one 'two 'three) + (set-new 'a 'b 'c)) + (not + (set-distinct? (set-new 1 2 3) + (set-new 3 4 5))) + (not + (set-distinct? (set-new 1 2 3) + (set-new 1 2 3))))) + +(ert-deftest set-equal? () + (and + (set-equal? (set-new 'a 'b 'c) + (set-new 'x 'y 'z)) + (set-equal? (set-new 'a 'b 'c) + (set-new 'a 'b)) + (set-equal? (set-new 'a 'b 'c) + (set-new 'a 'b 'c)))) + +(ert-deftest set-intersection () + (set-equal? (set-new 2 3) + (set-intersection (set-new 1 2 3) + (set-new 2 3 4)))) + +(ert-deftest set-to/from-list () + (equal '(1 2 3) + (->> '(1 1 2 2 3 3) + set-from-list + set-to-list))) + +(ert-deftest set-subset? () + (let ((primary-colors (set-new "red" "green" "blue"))) + ;; set-subset? + (and + (set-subset? (set-new "black" "grey") + primary-colors) + (set-subset? (set-new "red") + primary-colors)))) + +(ert-deftest set-subset/superset? () + (let ((primary-colors (set-new "red" "green" "blue"))) + ;; set-subset? + (and + (not (set-superset? primary-colors + (set-new "black" "grey"))) + (set-superset? primary-colors + (set-new "red" "green" "blue")) + (set-superset? primary-colors + (set-new "red" "blue"))))) + +(ert-deftest set-empty? () + (and + (set-empty? (set-new)) + (set-empty? (set-new 1 2 3)))) + +(ert-deftest set-count () + (and + (= 0 (set-count (set-new))) + (= 2 (set-count (set-new 1 1 2 2))))) diff --git a/users/wpcarro/emacs/pkgs/struct/default.nix b/users/wpcarro/emacs/pkgs/struct/default.nix new file mode 100644 index 000000000000..3ea514fcd6fc --- /dev/null +++ b/users/wpcarro/emacs/pkgs/struct/default.nix @@ -0,0 +1,29 @@ +{ pkgs, depot, ... }: + +let + struct = pkgs.callPackage + ({ emacsPackages }: + emacsPackages.trivialBuild { + pname = "struct"; + version = "1.0.0"; + src = ./struct.el; + packageRequires = + (with emacsPackages; [ + dash + s + ]); + }) + { }; + + emacs = (pkgs.emacsPackagesFor pkgs.emacs28).emacsWithPackages (epkgs: [ + epkgs.dash + struct + ]); +in +struct.overrideAttrs (_old: { + doCheck = true; + checkPhase = '' + ${emacs}/bin/emacs -batch \ + -l ert -l ${./tests.el} -f ert-run-tests-batch-and-exit + ''; +}) diff --git a/users/wpcarro/emacs/.emacs.d/wpc/struct.el b/users/wpcarro/emacs/pkgs/struct/struct.el index eeea04bf26bc..36d9d4ac0b9e 100644 --- a/users/wpcarro/emacs/.emacs.d/wpc/struct.el +++ b/users/wpcarro/emacs/pkgs/struct/struct.el @@ -17,26 +17,23 @@ ;; Dependencies ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(require 'string) +(require 's) (require 'dash) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Library ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar struct--enable-tests? t - "When t, run the test suite defined herein.") - (defmacro struct-update (type field f xs) "Apply F to FIELD in XS, which is a struct of TYPE. This is immutable." (let ((copier (->> type symbol-name - (string-prepend "copy-") + (s-prepend "copy-") intern)) (accessor (->> field symbol-name - (string-prepend (string-concat (symbol-name type) "-")) + (s-prepend (s-concat (symbol-name type) "-")) intern))) `(let ((copy (,copier ,xs))) (setf (,accessor copy) (funcall ,f (,accessor copy))) @@ -46,11 +43,11 @@ This is immutable." "Immutably set FIELD in XS (struct TYPE) to X." (let ((copier (->> type symbol-name - (string-prepend "copy-") + (s-prepend "copy-") intern)) (accessor (->> field symbol-name - (string-prepend (string-concat (symbol-name type) "-")) + (s-prepend (s-concat (symbol-name type) "-")) intern))) `(let ((copy (,copier ,xs))) (setf (,accessor copy) ,x) @@ -61,25 +58,11 @@ This is immutable." This is an adapter interface to `setf'." (let ((accessor (->> field symbol-name - (string-prepend (string-concat (symbol-name type) "-")) + (s-prepend (s-concat (symbol-name type) "-")) intern))) `(progn (setf (,accessor ,xs) ,x) ,xs))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Tests -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(when struct--enable-tests? - (cl-defstruct dummy name age) - (defvar struct--test-dummy (make-dummy :name "Roofus" :age 19)) - (struct-set! dummy name "Doofus" struct--test-dummy) - (prelude-assert (string= "Doofus" (dummy-name struct--test-dummy))) - (let ((result (struct-set dummy name "Shoofus" struct--test-dummy))) - ;; Test the immutability of `struct-set' - (prelude-assert (string= "Doofus" (dummy-name struct--test-dummy))) - (prelude-assert (string= "Shoofus" (dummy-name result))))) - (provide 'struct) ;;; struct.el ends here diff --git a/users/wpcarro/emacs/pkgs/struct/tests.el b/users/wpcarro/emacs/pkgs/struct/tests.el new file mode 100644 index 000000000000..619c54f451f8 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/struct/tests.el @@ -0,0 +1,25 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'ert) +(require 'dash) +(require 'struct) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(ert-deftest struct-set! () + (cl-defstruct dummy name age) + (defvar struct--test-dummy (make-dummy :name "Roofus" :age 19)) + (struct-set! dummy name "Doofus" struct--test-dummy) + (string= "Doofus" (dummy-name struct--test-dummy))) + +(ert-deftest struct-set () + (cl-defstruct dummy name age) + (defvar struct--test-dummy (make-dummy :name "Roofus" :age 19)) + (let ((result (struct-set dummy name "Shoofus" struct--test-dummy))) + (and + (string= "Roofus" (dummy-name struct--test-dummy)) + (string= "Shoofus" (dummy-name result))))) |