mdebray/tvl-depot
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

feat(wpcarro/emacs): Package al, list, set, struct

Browse source 
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 <wpcarro@gmail.com>
Autosubmit: wpcarro <wpcarro@gmail.com>
Tested-by: BuildkiteCI
This commit is contained in:
William Carroll 2022-07-28 20:29:07 -07:00 • committed by clbot
parent caf068253a
commit 15c9ff4902
13 changed files with 323 additions and 165 deletions
Download patch file Download diff file Expand all files Collapse all files

225
users/wpcarro/emacs/pkgs/al/al.el Normal file
View file

@ -0,0 +1,225 @@
;;; al.el --- Interface for working with associative lists -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; 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

28
users/wpcarro/emacs/pkgs/al/default.nix Normal file
View file

@ -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
'';
})

34
users/wpcarro/emacs/pkgs/al/tests.el Normal file
View file

@ -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)))))

28
users/wpcarro/emacs/pkgs/list/default.nix Normal file
View file

@ -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
'';
})

193
users/wpcarro/emacs/pkgs/list/list.el Normal file
View file

@ -0,0 +1,193 @@
;;; list.el --- Functions for working with lists -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; 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

32
users/wpcarro/emacs/pkgs/list/tests.el Normal file
View file

@ -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))))

32
users/wpcarro/emacs/pkgs/set/default.nix Normal file
View file

@ -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
'';
})

116
users/wpcarro/emacs/pkgs/set/set.el Normal file
View file

@ -0,0 +1,116 @@
;;; set.el --- Working with mathematical sets -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; 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

78
users/wpcarro/emacs/pkgs/set/tests.el Normal file
View file

@ -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)))))

29
users/wpcarro/emacs/pkgs/struct/default.nix Normal file
View file

@ -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
'';
})

68
users/wpcarro/emacs/pkgs/struct/struct.el Normal file
View file

@ -0,0 +1,68 @@
;;; struct.el --- Helpers for working with structs -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; 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

25
users/wpcarro/emacs/pkgs/struct/tests.el Normal file
View file

@ -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)))))