From 15c9ff49026f9ddbb42f663dfbc2668faa74cab2 Mon Sep 17 00:00:00 2001 From: William Carroll Date: Thu, 28 Jul 2022 20:29:07 -0700 Subject: feat(wpcarro/emacs): Package al, list, set, struct Originally I set-out to package `al.el`, but as I started traversing the dependencies, I needed to package increasingly more packages. I refactored some of these to prune their dependencies to slay this hydra before it turned into a never-ending project. I have mixed feelings about this. I also introduced `ert` and unit tests into my Elisp packaging, so it'll be nice to have build-time tests that run when Emacs updates land in depot. Change-Id: I2756dc60888b80255a495e08ae61bd547e6b3db2 Reviewed-on: https://cl.tvl.fyi/c/depot/+/5998 Reviewed-by: wpcarro Autosubmit: wpcarro Tested-by: BuildkiteCI --- users/wpcarro/emacs/pkgs/al/al.el | 225 ++++++++++++++++++++++++++++ users/wpcarro/emacs/pkgs/al/default.nix | 28 ++++ users/wpcarro/emacs/pkgs/al/tests.el | 34 +++++ users/wpcarro/emacs/pkgs/list/default.nix | 28 ++++ users/wpcarro/emacs/pkgs/list/list.el | 193 ++++++++++++++++++++++++ users/wpcarro/emacs/pkgs/list/tests.el | 32 ++++ users/wpcarro/emacs/pkgs/set/default.nix | 32 ++++ users/wpcarro/emacs/pkgs/set/set.el | 116 ++++++++++++++ users/wpcarro/emacs/pkgs/set/tests.el | 78 ++++++++++ users/wpcarro/emacs/pkgs/struct/default.nix | 29 ++++ users/wpcarro/emacs/pkgs/struct/struct.el | 68 +++++++++ users/wpcarro/emacs/pkgs/struct/tests.el | 25 ++++ 12 files changed, 888 insertions(+) create mode 100644 users/wpcarro/emacs/pkgs/al/al.el create mode 100644 users/wpcarro/emacs/pkgs/al/default.nix create mode 100644 users/wpcarro/emacs/pkgs/al/tests.el create mode 100644 users/wpcarro/emacs/pkgs/list/default.nix create mode 100644 users/wpcarro/emacs/pkgs/list/list.el create mode 100644 users/wpcarro/emacs/pkgs/list/tests.el create mode 100644 users/wpcarro/emacs/pkgs/set/default.nix create mode 100644 users/wpcarro/emacs/pkgs/set/set.el create mode 100644 users/wpcarro/emacs/pkgs/set/tests.el create mode 100644 users/wpcarro/emacs/pkgs/struct/default.nix create mode 100644 users/wpcarro/emacs/pkgs/struct/struct.el create mode 100644 users/wpcarro/emacs/pkgs/struct/tests.el (limited to 'users/wpcarro/emacs/pkgs') diff --git a/users/wpcarro/emacs/pkgs/al/al.el b/users/wpcarro/emacs/pkgs/al/al.el new file mode 100644 index 0000000000..aa81894153 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/al/al.el @@ -0,0 +1,225 @@ +;;; al.el --- Interface for working with associative lists -*- lexical-binding: t -*- + +;; Author: William Carroll +;; Version: 0.0.1 +;; Package-Requires: ((emacs "25.1")) + +;;; Commentary: +;; Firstly, a rant: +;; In most cases, I find Elisp's APIs to be confusing. There's a mixture of +;; overloaded functions that leak the implementation details (TODO: provide an +;; example of this.) of the abstract data type, which I find privileges those +;; "insiders" who spend disproportionately large amounts of time in Elisp land, +;; and other functions with little-to-no pattern about the order in which +;; arguments should be applied. In theory, however, most of these APIs could +;; and should be much simpler. This module represents a step in that direction. +;; +;; I'm modelling these APIs after Elixir's APIs. +;; +;; On my wishlist is to create protocols that will allow generic interfaces like +;; Enum protocols, etc. Would be nice to abstract over... +;; - associative lists (i.e. alists) +;; - property lists (i.e. plists) +;; - hash tables +;; ...with some dictionary or map-like interface. This will probably end up +;; being quite similar to the kv.el project but with differences at the API +;; layer. +;; +;; Similar libraries: +;; - map.el: Comes bundled with recent versions of Emacs. +;; - asoc.el: Helpers for working with alists. asoc.el is similar to alist.el +;; because it uses the "!" convention for signalling that a function mutates +;; the underlying data structure. +;; - ht.el: Hash table library. +;; - kv.el: Library for dealing with key-value collections. Note that map.el +;; has a similar typeclass because it works with lists, hash-tables, or +;; arrays. +;; - a.el: Clojure-inspired way of working with key-value data structures in +;; Elisp. Works with alists, hash-tables, and sometimes vectors. +;; +;; Some API design principles: +;; - The "noun" (i.e. alist) of the "verb" (i.e. function) comes last to improve +;; composability with the threading macro (i.e. `->>') and to improve consumers' +;; intuition with the APIs. Learn this once, know it always. +;; +;; - Every function avoids mutating the alist unless it ends with !. +;; +;; - CRUD operations will be named according to the following table: +;; - "create" *and* "set" +;; - "read" *and* "get" +;; - "update" +;; - "delete" *and* "remove" +;; +;; For better or worse, all of this code expects alists in the form of: +;; ((first-name . "William") (last-name . "Carroll")) +;; +;; Special thanks to github.com/alphapapa/emacs-package-dev-handbook for some of +;; the idiomatic ways to update alists. +;; +;; TODO: Include a section that compares alist.el to a.el from +;; github.com/plexus/a.el. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies: +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'dash) +(require 'list) +(require 'map) + +;; TODO: Support function aliases for: +;; - create/set +;; - read/get +;; - update +;; - delete/remove + +;; Support mutative variants of functions with an ! appendage to their name. + +;; Ensure that the same message about only updating the first occurrence of a +;; key is consistent throughout documentation using string interpolation or some +;; other mechanism. + +;; TODO: Consider wrapping all of this with `(cl-defstruct alist xs)'. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; TODO: Support a variadic version of this to easily construct alists. +(defun al-new () + "Return a new, empty alist." + '()) + +;; Create +;; TODO: See if this mutates. +(defun al-set (k v xs) + "Set K to V in XS." + (if (al-has-key? k xs) + (progn + ;; Note: this is intentional `alist-get' and not `al-get'. + (setf (alist-get k xs) v) + xs) + (list-cons `(,k . ,v) xs))) + +(defun al-set! (k v xs) + "Set K to V in XS mutatively. +Note that this doesn't append to the alist in the way that most alists handle + writing. If the k already exists in XS, it is overwritten." + (map-delete xs k) + (map-put! xs k v)) + +;; Read +(defun al-get (k xs) + "Return the value at K in XS; otherwise, return nil. +Returns the first occurrence of K in XS since alists support multiple entries." + (cdr (assoc k xs))) + +(defun al-get-entry (k xs) + "Return the first key-value pair at K in XS." + (assoc k xs)) + +;; Update +;; TODO: Add warning about only the first occurrence being updated in the +;; documentation. +(defun al-update (k f xs) + "Apply F to the value stored at K in XS. +If `K' is not in `XS', this function errors. Use `al-upsert' if you're +interested in inserting a value when a key doesn't already exist." + (if (not (al-has-key? k xs)) + (error "Refusing to update: key does not exist in alist") + (al-set k (funcall f (al-get k xs)) xs))) + +(defun al-update! (k f xs) + "Call F on the entry at K in XS. +Mutative variant of `al-update'." + (al-set! k (funcall f (al-get k xs))xs)) + +;; TODO: Support this. +(defun al-upsert (k v f xs) + "If K exists in `XS' call `F' on the value otherwise insert `V'." + (if (al-has-key? k xs) + (al-update k f xs) + (al-set k v xs))) + +;; Delete +;; TODO: Make sure `delete' and `remove' behave as advertised in the Elisp docs. +(defun al-delete (k xs) + "Deletes the entry of K from XS. +This only removes the first occurrence of K, since alists support multiple + key-value entries. See `al-delete-all' and `al-dedupe'." + (remove (assoc k xs) xs)) + +(defun al-delete! (k xs) + "Delete the entry of K from XS. +Mutative variant of `al-delete'." + (delete (assoc k xs) xs)) + +;; Additions to the CRUD API +;; TODO: Implement this function. +(defun al-dedupe-keys (xs) + "Remove the entries in XS where the keys are `equal'.") + +(defun al-dedupe-entries (xs) + "Remove the entries in XS where the key-value pair are `equal'." + (delete-dups xs)) + +(defun al-keys (xs) + "Return a list of the keys in XS." + (mapcar 'car xs)) + +(defun al-values (xs) + "Return a list of the values in XS." + (mapcar 'cdr xs)) + +(defun al-has-key? (k xs) + "Return t if XS has a key `equal' to K." + (not (eq nil (assoc k xs)))) + +(defun al-has-value? (v xs) + "Return t if XS has a value of V." + (not (eq nil (rassoc v xs)))) + +(defun al-count (xs) + "Return the number of entries in XS." + (length xs)) + +;; TODO: Should I support `al-find-key' and `al-find-value' variants? +(defun al-find (p xs) + "Find an element in XS. + +Apply a predicate fn, P, to each key and value in XS and return the key of the +first element that returns t." + (let ((result (list-find (lambda (x) (funcall p (car x) (cdr x))) xs))) + (if result + (car result) + nil))) + +(defun al-map-keys (f xs) + "Call F on the values in XS, returning a new alist." + (list-map (lambda (x) + `(,(funcall f (car x)) . ,(cdr x))) + xs)) + +(defun al-map-values (f xs) + "Call F on the values in XS, returning a new alist." + (list-map (lambda (x) + `(,(car x) . ,(funcall f (cdr x)))) + xs)) + +(defun al-reduce (acc f xs) + "Return a new alist by calling F on k v and ACC from XS. +F should return a tuple. See tuple.el for more information." + (->> (al-keys xs) + (list-reduce acc + (lambda (k acc) + (funcall f k (al-get k xs) acc))))) + +(defun al-merge (a b) + "Return a new alist with a merge of alists, A and B. +In this case, the last writer wins, which is B." + (al-reduce a #'al-set b)) + +(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 0000000000..d88e0757a8 --- /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 0000000000..5146ee6b21 --- /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 0000000000..490c0ba174 --- /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/pkgs/list/list.el b/users/wpcarro/emacs/pkgs/list/list.el new file mode 100644 index 0000000000..836eee89eb --- /dev/null +++ b/users/wpcarro/emacs/pkgs/list/list.el @@ -0,0 +1,193 @@ +;;; list.el --- Functions for working with lists -*- lexical-binding: t -*- + +;; Author: William Carroll +;; Version: 0.0.1 +;; Package-Requires: ((emacs "24")) + +;;; Commentary: +;; Since I prefer having the `list-' namespace, I wrote this module to wrap many +;; of the functions that are defined in the the global namespace in ELisp. I +;; sometimes forget the names of these functions, so it's nice for them to be +;; organized like this. +;; +;; Motivation: +;; Here are some examples of function names that I cannot tolerate: +;; - `car': Return the first element (i.e. "head") of a linked list +;; - `cdr': Return the tail of a linked list + +;; As are most APIs for standard libraries that I write, this is heavily +;; influenced by Elixir's standard library. +;; +;; Elixir's List library: +;; - ++/2 +;; - --/2 +;; - hd/1 +;; - tl/1 +;; - in/2 +;; - length/1 +;; +;; Similar libraries: +;; - dash.el: Functional library that mimmicks Clojure. It is consumed herein. +;; - list-utils.el: Utility library that covers things that dash.el may not +;; cover. +;; stream.el: Elisp implementation of streams, "implemented as delayed +;; evaluation of cons cells." + +;; TODO: Consider naming this file linked-list.el. + +;; TODO: Support module-like macro that auto-namespaces functions. + +;; TODO: Consider wrapping most data structures like linked-lists, +;; associative-lists, etc in a `cl-defstruct', so that the dispatching by type +;; can be nominal instead of duck-typing. I'm not sure if this is a good idea +;; or not. If I do this, I should provide isomorphisms to map between idiomatic +;; ways of working with Elisp data structures and my wrapped variants. + +;; TODO: Are function aliases/synonyms even a good idea? Or do they just +;; bloat the API unnecessarily? + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'dash) +(require 'set) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun list-new () + "Return a new, empty list." + '()) + +(defun list-concat (&rest lists) + "Joins `LISTS' into on list." + (apply #'-concat lists)) + +(defun list-join (joint xs) + "Join a list of strings, XS, with JOINT." + (if (list-empty? xs) + "" + (list-reduce (list-first xs) + (lambda (x acc) + (string-concat acc joint x)) + (list-tail xs)))) + +(defun list-length (xs) + "Return the number of elements in `XS'." + (length xs)) + +(defun list-get (i xs) + "Return the value in `XS' at `I', or nil." + (nth i xs)) + +(defun list-head (xs) + "Return the head of `XS'." + (car xs)) + +;; TODO: Learn how to write proper function aliases. +(defun list-first (xs) + "Alias for `list-head' for `XS'." + (list-head xs)) + +(defun list-tail (xs) + "Return the tail of `XS'." + (cdr xs)) + +(defun list-reverse (xs) + "Reverses `XS'." + (reverse xs)) + +(defun list-cons (x xs) + "Add `X' to the head of `XS'." + (cons x xs)) + +;; map, filter, reduce + +;; TODO: Create function adapters like swap. +;; (defun adapter/swap (f) +;; "Return a new function that wraps `F' and swaps the arguments." +;; (lambda (a b) +;; (funcall f b a))) + +;; TODO: Make this function work. +(defun list-reduce (acc f xs) + "Return over `XS' calling `F' on an element in `XS'and `ACC'." + (-reduce-from (lambda (acc x) (funcall f x acc)) acc xs)) + +(defun list-map (f xs) + "Call `F' on each element of `XS'." + (-map f xs)) + +(defun list-map-indexed (f xs) + "Call `F' on each element of `XS' along with its index." + (-map-indexed (lambda (i x) (funcall f x i)) xs)) + +(defun list-filter (p xs) + "Return a subset of XS where predicate P returned t." + (list-reverse + (list-reduce + '() + (lambda (x acc) + (if (funcall p x) + (list-cons x acc) + acc)) + xs))) + +(defun list-reject (p xs) + "Return a subset of XS where predicate of P return nil." + (list-filter (lambda (x) (not (funcall p x))) xs)) + +(defun list-find (p xs) + "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 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun list-instance? (xs) + "Return t if `XS' is a list. +Be leery of using this with things like alists. Many data structures in Elisp + are implemented using linked lists." + (listp xs)) + +(defun list-empty? (xs) + "Return t if XS are empty." + (= 0 (list-length xs))) + +(defun list-all? (p xs) + "Return t if all `XS' pass the predicate, `P'." + (-all? p xs)) + +(defun list-any? (p xs) + "Return t if any `XS' pass the predicate, `P'." + (-any? p xs)) + +(defun list-contains? (x xs) + "Return t if X is in XS using `equal'." + (-contains? xs x)) + +(defun list-xs-distinct-by? (f xs) + "Return t if all elements in XS are distinct after applying F to each." + (= (length xs) + (->> xs (-map f) set-from-list set-count))) + +(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 0000000000..2f7090d467 --- /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 0000000000..319ba92744 --- /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/pkgs/set/set.el b/users/wpcarro/emacs/pkgs/set/set.el new file mode 100644 index 0000000000..2d6e14917a --- /dev/null +++ b/users/wpcarro/emacs/pkgs/set/set.el @@ -0,0 +1,116 @@ +;;; set.el --- Working with mathematical sets -*- lexical-binding: t -*- + +;; Author: William Carroll +;; Version: 0.0.1 +;; Package-Requires: ((emacs "24.3")) + +;;; Commentary: +;; The set data structure is a collection that deduplicates its elements. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'cl-lib) +(require 'dash) +(require 'ht) ;; friendlier API for hash-tables +(require 'struct) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Wish List +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; - TODO: Support enum protocol for set. +;; - TODO: Prefer a different hash-table library that doesn't rely on mutative +;; code. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(cl-defstruct set xs) + +(defun set-from-list (xs) + "Create a new set from the list XS." + (make-set :xs (->> xs + (-map (lambda (x) (cons x nil))) + ht-from-alist))) + +(defun set-new (&rest args) + "Create a new set from ARGS." + (set-from-list args)) + +(defun set-to-list (xs) + "Map set XS into a list." + (->> xs + set-xs + ht-keys)) + +(defun set-add (x xs) + "Add X to set XS." + (struct-update set + xs + (lambda (table) + (let ((table-copy (ht-copy table))) + (ht-set table-copy x nil) + table-copy)) + xs)) + +;; TODO: Ensure all `*/reduce' functions share the same API. +(defun set-reduce (acc f xs) + "Return a new set by calling F on each element of XS and ACC." + (->> xs + set-to-list + (-reduce-from (lambda (acc x) (funcall f x acc)) acc))) + +(defun set-intersection (a b) + "Return the set intersection between A and B." + (set-reduce (set-new) + (lambda (x acc) + (if (set-contains? x b) + (set-add x acc) + acc)) + a)) + +(defun set-count (xs) + "Return the number of elements in XS." + (->> xs + set-xs + ht-size)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Predicates +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun set-empty? (xs) + "Return t if XS has no elements in it." + (= 0 (set-count xs))) + +(defun set-contains? (x xs) + "Return t if set XS has X." + (ht-contains? (set-xs xs) x)) + +;; TODO: Prefer using `ht.el' functions for this. +(defun set-equal? (a b) + "Return t if A and B share the name members." + (ht-equal? (set-xs a) + (set-xs b))) + +(defun set-distinct? (a b) + "Return t if A and B have no shared members." + (set-empty? (set-intersection a b))) + +(defun set-superset? (a b) + "Return t if A has all of the members of B." + (->> b + set-to-list + (-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)) + +(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 0000000000..3544364897 --- /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 0000000000..3ea514fcd6 --- /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/pkgs/struct/struct.el b/users/wpcarro/emacs/pkgs/struct/struct.el new file mode 100644 index 0000000000..36d9d4ac0b --- /dev/null +++ b/users/wpcarro/emacs/pkgs/struct/struct.el @@ -0,0 +1,68 @@ +;;; struct.el --- Helpers for working with structs -*- lexical-binding: t -*- + +;; Author: William Carroll +;; Version: 0.0.1 +;; Package-Requires: ((emacs "24.3")) + +;;; Commentary: +;; Provides new macros for working with structs. Also provides adapter +;; interfaces to existing struct macros, that should have more intuitive +;; interfaces. +;; +;; Sometimes `setf' just isn't enough. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 's) +(require 'dash) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(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 + (s-prepend "copy-") + intern)) + (accessor (->> field + symbol-name + (s-prepend (s-concat (symbol-name type) "-")) + intern))) + `(let ((copy (,copier ,xs))) + (setf (,accessor copy) (funcall ,f (,accessor copy))) + copy))) + +(defmacro struct-set (type field x xs) + "Immutably set FIELD in XS (struct TYPE) to X." + (let ((copier (->> type + symbol-name + (s-prepend "copy-") + intern)) + (accessor (->> field + symbol-name + (s-prepend (s-concat (symbol-name type) "-")) + intern))) + `(let ((copy (,copier ,xs))) + (setf (,accessor copy) ,x) + copy))) + +(defmacro struct-set! (type field x xs) + "Set FIELD in XS (struct TYPE) to X mutably. +This is an adapter interface to `setf'." + (let ((accessor (->> field + symbol-name + (s-prepend (s-concat (symbol-name type) "-")) + intern))) + `(progn + (setf (,accessor ,xs) ,x) + ,xs))) + +(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 0000000000..619c54f451 --- /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))))) -- cgit 1.4.1