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/.emacs.d/wpc/al.el | 254 ---------------------------- users/wpcarro/emacs/.emacs.d/wpc/list.el | 221 ------------------------ users/wpcarro/emacs/.emacs.d/wpc/set.el | 174 ------------------- users/wpcarro/emacs/.emacs.d/wpc/struct.el | 85 ---------- users/wpcarro/emacs/default.nix | 4 + 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 +++ 17 files changed, 892 insertions(+), 734 deletions(-) delete mode 100644 users/wpcarro/emacs/.emacs.d/wpc/al.el delete mode 100644 users/wpcarro/emacs/.emacs.d/wpc/list.el delete mode 100644 users/wpcarro/emacs/.emacs.d/wpc/set.el delete mode 100644 users/wpcarro/emacs/.emacs.d/wpc/struct.el 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') diff --git a/users/wpcarro/emacs/.emacs.d/wpc/al.el b/users/wpcarro/emacs/.emacs.d/wpc/al.el deleted file mode 100644 index 3cf98fee296b..000000000000 --- a/users/wpcarro/emacs/.emacs.d/wpc/al.el +++ /dev/null @@ -1,254 +0,0 @@ -;;; 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 'macros) -(require 'dash) -(require 'tuple) -(require 'maybe) - -;; 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)'. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Constants -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst al-enable-tests? t - "When t, run the test suite.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; 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." - (maybe-some? (assoc k xs))) - -(defun al-has-value? (v xs) - "Return t if XS has a value of V." - (maybe-some? (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)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; 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/.emacs.d/wpc/list.el b/users/wpcarro/emacs/.emacs.d/wpc/list.el deleted file mode 100644 index 2f1509eeb4a9..000000000000 --- a/users/wpcarro/emacs/.emacs.d/wpc/list.el +++ /dev/null @@ -1,221 +0,0 @@ -;;; 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 -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; 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.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; 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)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; 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))) - -;; 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/.emacs.d/wpc/set.el b/users/wpcarro/emacs/.emacs.d/wpc/set.el deleted file mode 100644 index 778b089e156b..000000000000 --- a/users/wpcarro/emacs/.emacs.d/wpc/set.el +++ /dev/null @@ -1,174 +0,0 @@ -;;; 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: - -(require 'ht) ;; friendlier API for hash-tables -(require 'dotted) -(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) - -(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) - 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 - (list-reduce acc f))) - -(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 - (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)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; 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/.emacs.d/wpc/struct.el b/users/wpcarro/emacs/.emacs.d/wpc/struct.el deleted file mode 100644 index eeea04bf26bc..000000000000 --- a/users/wpcarro/emacs/.emacs.d/wpc/struct.el +++ /dev/null @@ -1,85 +0,0 @@ -;;; 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 'string) -(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-") - intern)) - (accessor (->> field - symbol-name - (string-prepend (string-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 - (string-prepend "copy-") - intern)) - (accessor (->> field - symbol-name - (string-prepend (string-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 - (string-prepend (string-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/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/pkgs/al/al.el b/users/wpcarro/emacs/pkgs/al/al.el new file mode 100644 index 000000000000..aa818941535f --- /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 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/pkgs/list/list.el b/users/wpcarro/emacs/pkgs/list/list.el new file mode 100644 index 000000000000..836eee89ebf3 --- /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 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/pkgs/set/set.el b/users/wpcarro/emacs/pkgs/set/set.el new file mode 100644 index 000000000000..2d6e14917a45 --- /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 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/pkgs/struct/struct.el b/users/wpcarro/emacs/pkgs/struct/struct.el new file mode 100644 index 000000000000..36d9d4ac0b9e --- /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 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))))) -- cgit 1.4.1