git.iko.soy/bat
on 3d07dec help sign in
bat/tests/syntax-tests/source/Lisp/utils.lisp
80 lines 2.9 kB history raw
1(cl:defpackage :chillax.utils
2 (:use :cl :alexandria)
3 (:export
4 :fun :mkhash :hashget :strcat :dequote :at))
5(in-package :chillax.utils)
7;;; Functions
8(defmacro fun (&body body)
9 "This macro puts the FUN back in FUNCTION."
10 `(lambda (&optional _) (declare (ignorable _)) ,@body))
12;;; Hash tables
13(defun mkhash (&rest keys-and-values &aux (table (make-hash-table :test #'equal)))
14 "Convenience function for `literal' hash table definition."
15 (loop for (key val) on keys-and-values by #'cddr do (setf (gethash key table) val)
16 finally (return table)))
18(defun hashget (hash &rest keys)
19 "Convenience function for recursively accessing hash tables."
20 (reduce (lambda (h k) (gethash k h)) keys :initial-value hash))
22(define-compiler-macro hashget (hash &rest keys)
23 (if (null keys) hash
24 (let ((hash-sym (make-symbol "HASH"))
25 (key-syms (loop for i below (length keys)
26 collect (make-symbol (format nil "~:@(~:R~)-KEY" i)))))
27 `(let ((,hash-sym ,hash)
28 ,@(loop for key in keys for sym in key-syms
29 collect `(,sym ,key)))
30 ,(reduce (lambda (hash key) `(gethash ,key ,hash))
31 key-syms :initial-value hash-sym)))))
33(defun (setf hashget) (new-value hash key &rest more-keys)
34 "Uses the last key given to hashget to insert NEW-VALUE into the hash table
35returned by the second-to-last key.
36tl;dr: DWIM SETF function for HASHGET."
37 (if more-keys
38 (setf (gethash (car (last more-keys))
39 (apply #'hashget hash key (butlast more-keys)))
40 new-value)
41 (setf (gethash key hash) new-value)))
43;;; Strings
44(defun strcat (string &rest more-strings)
45 (apply #'concatenate 'string string more-strings))
47(defun dequote (string)
48 (let ((len (length string)))
49 (if (and (> len 1) (starts-with #\" string) (ends-with #\" string))
50 (subseq string 1 (- len 1))
51 string)))
53;;;
54;;; At
55;;;
56(defgeneric at (doc &rest keys))
57(defgeneric (setf at) (new-value doc key &rest more-keys))
59(defmethod at ((doc hash-table) &rest keys)
60 (apply #'hashget doc keys))
61(defmethod (setf at) (new-value (doc hash-table) key &rest more-keys)
62 (apply #'(setf hashget) new-value doc key more-keys))
64(defmethod at ((doc list) &rest keys)
65 (reduce (lambda (alist key)
66 (cdr (assoc key alist :test #'equal)))
67 keys :initial-value doc))
68(defmethod (setf at) (new-value (doc list) key &rest more-keys)
69 (if more-keys
70 (setf (cdr (assoc (car (last more-keys))
71 (apply #'at doc key (butlast more-keys))
72 :test #'equal))
73 new-value)
74 (setf (cdr (assoc key doc :test #'equal)) new-value)))
76;; A playful alias.
77(defun @ (doc &rest keys)
78 (apply #'at doc keys))
79(defun (setf @) (new-value doc key &rest more-keys)
80 (apply #'(setf at) new-value doc key more-keys))