From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Tino Calancha Newsgroups: gmane.emacs.devel Subject: [ELPA] New package: hap.el Date: Wed, 01 Mar 2017 18:00:28 +0900 Message-ID: <8760jtgymr.fsf@calancha-pc> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: blaine.gmane.org 1488358887 31843 195.159.176.226 (1 Mar 2017 09:01:27 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Wed, 1 Mar 2017 09:01:27 +0000 (UTC) Cc: tino.calancha@gmail.com To: Emacs developers Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Wed Mar 01 10:01:18 2017 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cj08K-0007L3-Rd for ged-emacs-devel@m.gmane.org; Wed, 01 Mar 2017 10:01:17 +0100 Original-Received: from localhost ([::1]:39141 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cj08Q-0000xF-OC for ged-emacs-devel@m.gmane.org; Wed, 01 Mar 2017 04:01:22 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:39780) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cj07j-0000wv-Ie for emacs-devel@gnu.org; Wed, 01 Mar 2017 04:00:41 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cj07e-0008Dz-Lk for emacs-devel@gnu.org; Wed, 01 Mar 2017 04:00:39 -0500 Original-Received: from mail-pg0-x235.google.com ([2607:f8b0:400e:c05::235]:34187) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1cj07e-0008Ds-CT for emacs-devel@gnu.org; Wed, 01 Mar 2017 04:00:34 -0500 Original-Received: by mail-pg0-x235.google.com with SMTP id p5so18447542pga.1 for ; Wed, 01 Mar 2017 01:00:34 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:date:message-id:mime-version; bh=UCw1s3T1tJpg7qnGIsIlUwDbjBA/9FMnJP7GstNPb5I=; b=KE/x2tUCyo5xEMmhnC+8gChGsLm4E1Exylgrs2EBdbTJFTMBImnxQNAf8p+z+Bq+oA lN8J/z/oswdrw+eq5dYkiERTsF+frEqHkGcD5pl7GHEF1IWAEkK8O17hea+hfLMm1mMF ApI2o2XH3K1NL/x0uUfMGpVdPFHpUDxqj2dIW5nTY9Uv1CJ8Ef8PTJN+iRyJwGDM5Lsn alRJX8P9M9VMolpvO/y3SxpCcKSSmDAnhNOFPcogUybUMqOPbLteodKvqY4J1SQJzlfg 94xe7MXbySFvt3yU4wBqNQKzgVf640bwVAYnWSQjgzYh24ASiY7HXM6PbI/+YtuMq9U2 jDLg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:date:message-id:mime-version; bh=UCw1s3T1tJpg7qnGIsIlUwDbjBA/9FMnJP7GstNPb5I=; b=Yemk7NudoYI5JKh5yICgNpgUyTCiT27ZKiJG7rnk8vU3gzPcjRrcmoCLIIF891VU3O jL3xBP+k/4Y6fo+koiRPdz/nPNgPd7eYM7dN2GhohRwjUXBK7g5i2u6JOUCGKq+L4/hj EZcOsdCz1wj9fA66ig4HQHArL7rUalHYxhk412yPxgzhyPrbUBerIhgi6WvZrxcPhT1S CwAZnoZ756TcCoAZX/bXGqgFdc85fWLX8bTriFsVog9wTzWvImFLBGHxXZS9y/ZDqBiy fQonAcHy8VSOyyJglvcM811aZGtvUeus/CxePaSSeEwmcqcAWRHjCYicMSEwZZPkjQzV YkzA== X-Gm-Message-State: AMke39kny19dwK8VLIY3lW+d1XgCyOnwBsovMG/UJDPZ7cCjRzGTi7xL9LY4LdIL+TAmhA== X-Received: by 10.84.129.67 with SMTP id 61mr8924666plb.16.1488358832683; Wed, 01 Mar 2017 01:00:32 -0800 (PST) Original-Received: from calancha-pc (104.81.147.124.dy.bbexcite.jp. [124.147.81.104]) by smtp.gmail.com with ESMTPSA id m29sm8953372pfi.54.2017.03.01.01.00.31 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 01 Mar 2017 01:00:32 -0800 (PST) X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 2607:f8b0:400e:c05::235 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:212675 Archived-At: hap.el provides following items: *) Convert between alist, plist and hash table. E.g.: (hap-alist-to-hash-table '((1 . 2) (a . b))) => #s(hash-table size 65 test eql rehash-size 1.5 rehash-threshold 0.8125 data (1 2 a b)) *) Define constructors for alist, plist and hash table accepting two sequences: KEYS and VALUES. E.g.: (hap-alist '(1 2) [a b]) => ((1 . a) (2 . b)) *) Add functions to compare two hash tables. E.g.: (hap-hash-table= #s(hash-table data (1 a 2 b)) #s(hash-table data (1 a 2 b))) => t (or (hap-hash-table= #s(hash-table test equal data (1 a 2 b)) #s(hash-table data (1 a 2 b))) (hap-hash-table= #s(hash-table data (1 c 2 b)) #s(hash-table data (1 a 2 b)))) => nil It might be convenient to group together under same file all these related operations. Thus, I'd like to add this file to Elpa (or Emacs core, whatever is appropiate), in case people think it's useful. Regards, Tino --8<-----------------------------cut here---------------start------------->8--- ;;; hap.el --- Convert between hash table, alist and plist -*- lexical-binding: t; -*- ;; Copyright (C) 2017 Tino Calancha ;; Author: Tino Calancha ;; Created: Sun Feb 26 22:36:24 2017 ;; Maintainer: Tino Calancha ;; Keywords: lisp, extensions ;; Compatibility: GNU Emacs 24 ;; Version: 1.0 ;; Package-Requires: ((emacs "24.1") (cl-lib "0.5")) ;; This file is NOT part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . ;;; Commentary: ;; Obtain from a hash table, association list or a property list, ;; an equivalent representation using one of the other two structures. ;; ;; Equivalent doesn't necessarily mean equal data if one of the ;; structures is a hash table. ;; For instance, the ALIST '((foo . 1) (foo . 2) (bar . 3)) ;; might produce the following two hash tables: ;; ;; HASH-1 = #s(hash-table data (foo 2 bar 3)) ;; HASH-2 = #s(hash-table data (foo 1 bar 3)) ;; ;; Both have different data than ALIST because hash tables have ;; unique keys. ;; Note that only the second one satisfies: ;; (equal (cdr (assq foo ALIST)) ;; (gethash foo HASH-TABLE)) ;; ;; Functions `hap-alist-to-hash-table', `hap-plist-to-hash-table' and ;; `hap-hash-table' accept an optional argument UNIQ-KEY; when non-nil, ;; only the first occurrency of KEY is stored. Otherwise, each ;; occurrency of KEY updates the value. ;; ;; In the previous example you'd get HASH-1 with: ;; (hap-alist-to-hash-table ALIST) ;; ;; and you'd get HASH-2 with: ;; (hap-alist-to-hash-table nil 'uniq-key) ;; ;; This library define constructors for alist, plist or hash table ;; that accept two sequences as arguments: the keys and values. ;; E.g. ;; (hap-alist '(1 2) [a b]) ;; => ((1 . a) (2 . b)) ;; ;; In addition, this file adds functions to compare hash tables: ;; *) `hap-hash-table-data=' returns non-nil if two hash tables store ;; equal data. ;; *) `hap-hash-table-prop=' returns non-nil if two hash tables have ;; equal parameters. ;; *) `hap-hash-table=' returns non-nil if two hash tables store ;; equal data and have equal parameters. ;;; Code: (eval-when-compile (require 'cl-lib)) ;;; Compare hash tables. (defun hap-hash-table-data-equal (t1 t2) "Return non-nil if hash tables T1 and T2 store equal data." (cl-flet ((fn (x y) (catch 'not-equal (prog1 t ; Return t on success. (maphash (lambda (k v) (unless (equal v (gethash k y)) (throw 'not-equal nil))) x))))) (and (fn t1 t2) (fn t2 t1)))) (defalias 'hap-hash-table-data= 'hap-hash-table-data-equal) (defun hap-hash-table-prop-equal (t1 t2 &optional ignore-size) "Return non-nil if hash tables T1 and T2 have same properties. Optional arg IGNORE-SIZE non-nil, means ignore parameter size. Otherwise, compare all parameters. The data stored might be different. To compare the data as well see `hap-hash-table='." (and (or ignore-size (= (hash-table-size t1) (hash-table-size t2))) (= (hash-table-count t1) (hash-table-count t2)) (eq (hash-table-test t1) (hash-table-test t2)) (eq (hash-table-weakness t1) (hash-table-weakness t2)) (= (hash-table-rehash-size t1) (hash-table-rehash-size t2)) (= (hash-table-rehash-threshold t1) (hash-table-rehash-threshold t2)))) (defalias 'hap-hash-table-prop= 'hap-hash-table-prop-equal) (defun hap-hash-table-equal (t1 t2 &optional ignore-size) "Return non-nil if hash tables T1 and T2 have equal data and properties. Optional arg IGNORE-SIZE non-nil, means ignore parameter size. Otherwise, compare all parameters." (and (hap-hash-table-prop= t1 t2 ignore-size) (hap-hash-table-data= t1 t2))) (defalias 'hap-hash-table= 'hap-hash-table-equal) ;;; Make alist, plist or hash table from KEYS and VALUES. (defun hap-make-alist (keys values &optional cadrp) "Make an alist from the sequences KEYS and VALUES. If optional arg CADRP is non-nil, then store the values in the cadr. Otherwise, store them in the cdr." (cl-loop for k the elements of keys using (index idx) collect (let ((v (ignore-errors (elt values idx)))) (if cadrp (list k v) (cons k v))))) (defalias 'hap-alist 'hap-make-alist) (defun hap-alist-keys (alist) "Return a list with the keys in ALIST." (mapcar #'car alist)) (defun hap-alist-values (alist &optional cadrp) "Return a list with the values in ALIST. Optional arg CADRP non-nil, means ALIST store the values in the cadr." (mapcar (if cadrp #'cadr #'cdr) alist)) (defun hap-make-plist (keys values) "Make a property list from the sequences KEYS and VALUES." (cl-loop for k the elements of keys using (index idx) nconc (list k (ignore-errors (elt values idx))))) (defalias 'hap-plist 'hap-make-plist) (defun hap--plist-keys-or-values (plist &optional keys) (unless (= 0 (logand 1 (length plist))) (error "PLIST should have an even number of elements")) (let ((mod (if keys 0 1))) (cl-loop for x the elements of plist using (index idx) when (= mod (logand 1 idx)) collect x))) (defun hap-plist-keys (plist) "Return a list with the keys in PLIST." (hap--plist-keys-or-values plist 'keys)) (defun hap-plist-values (plist) "Return a list with the values in PLIST." (hap--plist-keys-or-values plist)) (defun hap--hash-table-init (kwrds len) (if (or (memq :size kwrds) (zerop len)) kwrds (let ((size (floor (max 65 (* 1.5 len))))) (append kwrds (list :size size))))) (defun hap-make-hash-table (keys values &optional uniq-key &rest kwrds) "Make a hash table from the sequences KEYS and VALUES. Optional arg UNIQ-KEY non-nil, means store just the first occurrency of each KEY. Otherwise, update the value associated with KEY each time. KWRDS are keyword/argument pairs as in `make-hash-table' with same defaults, except for size, which is set to (floor (max 65 (* 1.5 (length KEYS))))." (let ((ht (apply #'make-hash-table (hap--hash-table-init kwrds (length keys))))) (cl-loop for k the elements of keys using (index idx) do (let ((v (ignore-errors (elt values idx)))) (cond (uniq-key (when (eq '--hap-not-found (gethash k ht '--hap-not-found)) (puthash k v ht))) (t (puthash k v ht)))) ) ht)) (defalias 'hap-hash-table 'hap-make-hash-table) (defun hap-hash-table-keys (hash-table) "Return a list with the keys in HASH-TABLE." (cl-loop for k being the hash-keys of hash-table collect k)) (defun hap-hash-table-values (hash-table) "Return a list with the values in HASH-TABLE." (cl-loop for v being the hash-values of hash-table collect v)) ;;; Change keys <--> values, or in alist store values at cdr <--> cadr. (defun hap-plist-ninvert (plist) "Invert the keys and values in PLIST. This is a destructive function." (let ((lst plist)) (cl-loop while lst do (cl-rotatef (car lst) (cadr lst)) (pop lst) (pop lst)) plist)) (defun hap-plist-invert (plist) "Return a copy of PLIST with inverted keys and values." (cl-loop while plist nconc (let ((v (pop plist)) (k (pop plist))) (list k v)))) (defun hap-alist-ninvert (alist &optional cadrp) "Invert the keys and values in ALIST. Optional arg CADRP non-nil, means ALIST store the values in the cadr. This is a destructive function." (let ((lst alist)) (while lst (let ((x (car lst))) (if cadrp (nreverse x) (cl-rotatef (car x) (cdr x))) (pop lst))) alist)) (defun hap-alist-invert (alist &optional cadrp) "Return a copy of ALIST with inverted keys and values. Optional arg CADRP non-nil, means ALIST store the values in the cadr." (cl-loop for x in alist collect (if cadrp (list (cadr x) (car x)) (cons (cdr x) (car x))))) (defun hap-hash-table-invert (hash-table) "Return a copy of HASH-TABLE with inverted keys and values." (let ((ht (make-hash-table))) (cl-loop for k the hash-keys of hash-table using (hash-values v) do (puthash v k ht)) ht)) (defun hap-hash-table-ninvert (hash-table) "Invert keys and values in HASH-TABLE. This is a destructive function." (let ((ht hash-table)) (cl-loop for k the hash-keys of ht using (hash-values v) do (remhash k ht) (puthash v k ht)) ht)) (defun hap-alist-set-values-at-cdr (alist &optional cadrp) "Return a copy of ALIST with their values stored in the cdr. Optional arg CADRP non-nil, means ALIST store the values in the cadr." (if cadrp (cl-loop for x in alist collect (cons (car x) (cadr x))) (copy-sequence alist))) (defun hap-alist-set-values-at-cadr (alist &optional cadrp) "Return a copy of ALIST with their values stored in the cadr. Optional arg CADRP non-nil, means ALIST store the values in the cadr." (if cadrp (copy-sequence alist) (cl-loop for x in alist collect (list (car x) (cdr x))))) ;;; Convert between alist, plist and hash table. (defun hap-alist-to-plist (alist &optional cadrp) "Make a property list from ALIST. Optional arg CADRP non-nil, means ALIST store the values in the cadr." (cl-loop for x in alist nconc (list (car x) (if cadrp (cadr x) (cdr x))))) (defun hap-plist-to-alist (plist &optional cadrp) "Make an alist from the property list PLIST. Optional arg CADRP non-nil, means store the alist values in the cadr." (cl-loop while plist collect (let ((k (pop plist)) (v (pop plist))) (if cadrp (list k v) (cons k v))))) (defun hap-alist-to-hash-table (alist &optional cadrp uniq-key &rest kwrds) "Make a hash table from ALIST. Optional arg CADRP non-nil, means ALIST store the values in the cadr. Optional arg UNIQ-KEY non-nil, means store just the first occurrency of each KEY. That ensures that (gethash KEY HASH) in the resultant hash table equals (cdr (assoc KEY ALIST)). Otherwise, update the value associated with KEY each time. KWRDS are keyword/argument pairs as in `make-hash-table' with same defaults, except for size, which is set to (floor (max 65 (* 1.5 (length ALIST))))." (let ((ht (apply #'make-hash-table (hap--hash-table-init kwrds (length alist))))) (dolist (x alist) (let ((k (car x)) (v (or (and cadrp (cadr x)) (cdr x)))) (cond (uniq-key (and (eq '--hap-not-found (gethash k ht '--hap-not-found)) (puthash k v ht))) (t (puthash k v ht))) )) ht)) (defun hap-plist-to-hash-table (plist &optional uniq-key &rest kwrds) "Make a hash table from the property list PLIST. Optional arg UNIQ-KEY non-nil, means store just the first occurrency of each KEY. Otherwise, update the value associated with KEY each time. KWRDS are keyword/argument pairs as in `make-hash-table' with same defaults, except for size, which is set to (floor (max 65 (* 0.75 (length PLIST))))." (let ((ht (apply #'make-hash-table (hap--hash-table-init kwrds (/ (length plist) 2))))) (while plist (let ((k (pop plist)) (v (pop plist))) (cond (uniq-key (and (eq '--hap-not-found (gethash k ht '--hap-not-found)) (puthash k v ht))) (t (puthash k v ht))) )) ht)) (defun hap-hash-table-to-alist (ht &optional cadrp) "Make an alist from HASH-TABLE. Optional arg CADRP non-nil, means store the alist values in the cadr. \n(fn HASH-TABLE CADRP)" (cl-loop for k the hash-keys of ht using (hash-values v) collect (if cadrp (list k v) (cons k v)))) (defun hap-hash-table-to-plist (ht) "Make a property list from HASH-TABLE. \n(fn HASH-TABLE)" (cl-loop for k the hash-keys of ht using (hash-values v) nconc (list k v))) (provide 'hap) ;;; hap.el ends here --8<-----------------------------cut here---------------end--------------->8---