/src/utils.lisp
Lisp | 80 lines | 62 code | 11 blank | 7 comment | 6 complexity | 0da6da5045ab04f506369b9cb790a941 MD5 | raw file
1(cl:defpackage :chillax.utils 2 (:use :cl :alexandria) 3 (:export 4 :fun :mkhash :hashget :strcat :dequote :at)) 5(in-package :chillax.utils) 6 7;;; Functions 8(defmacro fun (&body body) 9 "This macro puts the FUN back in FUNCTION." 10 `(lambda (&optional _) (declare (ignorable _)) ,@body)) 11 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))) 17 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)) 21 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))))) 32 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))) 42 43;;; Strings 44(defun strcat (string &rest more-strings) 45 (apply #'concatenate 'string string more-strings)) 46 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))) 52 53;;; 54;;; At 55;;; 56(defgeneric at (doc &rest keys)) 57(defgeneric (setf at) (new-value doc key &rest more-keys)) 58 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)) 63 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))) 75 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))