dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

parseclj-alist.el (3488B)


      1 ;;; parseclj-alist.el --- Clojure/EDN parser              -*- lexical-binding: t; -*-
      2 
      3 ;; Copyright (C) 2017-2021  Arne Brasseur
      4 
      5 ;; Author: Arne Brasseur <arne@arnebrasseur.net>
      6 
      7 ;; This file is not part of GNU Emacs.
      8 
      9 ;; This file is free software; you can redistribute it and/or modify
     10 ;; it under the terms of the GNU General Public License as published by
     11 ;; the Free Software Foundation; either version 3, or (at your option)
     12 ;; any later version.
     13 
     14 ;; This file is distributed in the hope that it will be useful,
     15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     17 ;; GNU General Public License for more details.
     18 
     19 ;; You should have received a copy of the GNU General Public License
     20 ;; along with GNU Emacs; see the file COPYING.  If not, write to
     21 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
     22 ;; Boston, MA 02110-1301, USA.
     23 
     24 ;;; Commentary:
     25 
     26 ;; A shift/reduce parser for Clojure source.
     27 
     28 ;;; Code:
     29 
     30 (defun parseclj-alist (&rest kvs)
     31   "Create an association list from the given keys and values KVS.
     32 Arguments are simply provided in sequence, rather than as lists or cons cells.
     33 For example: (parseclj-alist :foo 123 :bar 456)"
     34   ;; Emacs 27:
     35   ;; (map-into kvs 'alist)
     36   (mapcar (lambda (kv) (cons (car kv) (cadr kv))) (seq-partition kvs 2)))
     37 
     38 (defun parseclj-alist-assoc (coll k v)
     39   "Associate a key K with a value V in the association list COLL
     40 
     41 Returns a new alist (does not mutate its argument). If an entry
     42 with the same key is present it will be replaced, otherwise the
     43 new kv-pair is added to the head of the list."
     44   (if (map-contains-key coll k)
     45       (mapcar (lambda (entry)
     46                 (if (equal (car entry) k)
     47                     (cons k v)
     48                   entry))
     49               coll)
     50     (cons (cons k v) coll)))
     51 
     52 (defun parseclj-alist-update (coll key fn &rest args)
     53   "In collection COLL, at location KEY, apply FN with extra args ARGS.
     54 'Updates' a value in an associative collection COLL, where KEY is
     55 a key and FN is a function that will take the old value and any
     56 supplied args and return the new value, and returns a new
     57 structure. If the key does not exist, nil is passed as the old
     58 value."
     59   (parseclj-alist-assoc coll
     60                         key
     61                         (apply #'funcall fn (map-elt coll key) args)))
     62 
     63 (defun parseclj-hash-table (&rest kvs)
     64   "Create a hash table from the given keys and values KVS.
     65 Arguments are simply provided in sequence, rather than as lists
     66 or cons cells. As \"test\" for the hash table, equal is used. The
     67 hash table is created without extra storage space, so with a size
     68 equal to amount of key-value pairs, since it is assumed to be
     69 treated as immutable.
     70 For example: (parseclj-hash-table :foo 123 :bar 456)"
     71   ;; Emacs 27:
     72   ;; (map-into kvs 'hash-table)
     73   (let* ((kv-pairs (seq-partition kvs 2))
     74          (hash-map (make-hash-table :test 'equal :size (length kv-pairs))))
     75     (seq-do (lambda (pair)
     76               (puthash (car pair) (cadr pair) hash-map))
     77             kv-pairs)
     78     hash-map))
     79 
     80 (defun parseclj-alist-merge (l1 l2)
     81   "Merge two association lists."
     82   ;; Emacs 27: (map-merge 'alist l1 l2)
     83   (let ((keys (delete-dups (append (mapcar #'car l1) (mapcar #'car l2))))
     84         (res '()))
     85     (mapcar
     86      (lambda (key)
     87        (push (or (assoc key l2)
     88                  (assoc key l1))
     89              res))
     90      keys)
     91     (nreverse res)))
     92 
     93 (provide 'parseclj-alist)
     94 
     95 ;;; parseclj-alist.el ends here