Archives/bat
2
0
Fork 0
mirror of https://github.com/sharkdp/bat synced 2024-11-16 21:25:56 +00:00
Code Issues Projects Releases Wiki Activity

update lisp test

Browse Source
This commit is contained in:
ccQpein 2024-05-31 12:39:19 -04:00
parent 503b2c5126
commit 25cd4991d2
1 changed files with 63 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

126
tests/syntax-tests/highlighted/Lisp/utils.lisp vendored
View File

@ -1,80 +1,80 @@
(cl:defpackage :chillax.utils (cl:defpackage :chillax.utils
 (:use :cl :alexandria)  (:use :cl :alexandria)
 (:export  (:export
 :fun :mkhash :hashget :strcat :dequote :at))  :fun :mkhash :hashget :strcat :dequote :at))
(in-package :chillax.utils) (in-package :chillax.utils)
;;; Functions ;;; Functions
(defmacro fun (&body body) (defmacro fun (&body body)
 "This macro puts the FUN back in FUNCTION."  "This macro puts the FUN back in FUNCTION."
 `(lambda (&optional _) (declare (ignorable _)) ,@body))  `(lambda (&optional _) (declare (ignorable _)) ,@body))
;;; Hash tables ;;; Hash tables
(defun mkhash (&rest keys-and-values &aux (table (make-hash-table :test #'equal))) (defun mkhash (&rest keys-and-values &aux (table (make-hash-table :test #'equal)))
 "Convenience function for `literal' hash table definition."  "Convenience function for `literal' hash table definition."
 (loop for (key val) on keys-and-values by #'cddr do (setf (gethash key table) val)  (loop for (key val) on keys-and-values by #'cddr do (setf (gethash key table) val)
 finally (return table)))  finally (return table)))
(defun hashget (hash &rest keys) (defun hashget (hash &rest keys)
 "Convenience function for recursively accessing hash tables."  "Convenience function for recursively accessing hash tables."
 (reduce (lambda (h k) (gethash k h)) keys :initial-value hash))  (reduce (lambda (h k) (gethash k h)) keys :initial-value hash))
(define-compiler-macro hashget (hash &rest keys) (define-compiler-macro hashget (hash &rest keys)
 (if (null keys) hash  (if (null keys) hash
 (let ((hash-sym (make-symbol "HASH"))  (let ((hash-sym (make-symbol "HASH"))
 (key-syms (loop for i below (length keys)  (key-syms (loop for i below (length keys)
 collect (make-symbol (format nil "~:@(~:R~)-KEY" i)))))  collect (make-symbol (format nil "~:@(~:R~)-KEY" i)))))
 `(let ((,hash-sym ,hash)  `(let ((,hash-sym ,hash)
 ,@(loop for key in keys for sym in key-syms  ,@(loop for key in keys for sym in key-syms
 collect `(,sym ,key)))  collect `(,sym ,key)))
 ,(reduce (lambda (hash key) `(gethash ,key ,hash))  ,(reduce (lambda (hash key) `(gethash ,key ,hash))
 key-syms :initial-value hash-sym)))))  key-syms :initial-value hash-sym)))))
(defun (setf hashget) (new-value hash key &rest more-keys) (defun (setf hashget) (new-value hash key &rest more-keys)
 "Uses the last key given to hashget to insert NEW-VALUE into the hash table  "Uses the last key given to hashget to insert NEW-VALUE into the hash table
returned by the second-to-last key. returned by the second-to-last key.
tl;dr: DWIM SETF function for HASHGET." tl;dr: DWIM SETF function for HASHGET."
 (if more-keys  (if more-keys
 (setf (gethash (car (last more-keys))  (setf (gethash (car (last more-keys))
 (apply #'hashget hash key (butlast more-keys)))  (apply #'hashget hash key (butlast more-keys)))
 new-value)  new-value)
 (setf (gethash key hash) new-value)))  (setf (gethash key hash) new-value)))
;;; Strings ;;; Strings
(defun strcat (string &rest more-strings) (defun strcat (string &rest more-strings)
 (apply #'concatenate 'string string more-strings))  (apply #'concatenate 'string string more-strings))
(defun dequote (string) (defun dequote (string)
 (let ((len (length string)))  (let ((len (length string)))
 (if (and (> len 1) (starts-with #\" string) (ends-with #\" string))  (if (and (> len 1) (starts-with #\" string) (ends-with #\" string))
 (subseq string 1 (- len 1))  (subseq string 1 (- len 1))
 string)))  string)))
;;; ;;;
;;; At ;;; At
;;; ;;;
(defgeneric at (doc &rest keys)) (defgeneric at (doc &rest keys))
(defgeneric (setf at) (new-value doc key &rest more-keys)) (defgeneric (setf at) (new-value doc key &rest more-keys))
(defmethod at ((doc hash-table) &rest keys) (defmethod at ((doc hash-table) &rest keys)
 (apply #'hashget doc keys))  (apply #'hashget doc keys))
(defmethod (setf at) (new-value (doc hash-table) key &rest more-keys) (defmethod (setf at) (new-value (doc hash-table) key &rest more-keys)
 (apply #'(setf hashget) new-value doc key more-keys))  (apply #'(setf hashget) new-value doc key more-keys))
(defmethod at ((doc list) &rest keys) (defmethod at ((doc list) &rest keys)
 (reduce (lambda (alist key)  (reduce (lambda (alist key)
 (cdr (assoc key alist :test #'equal)))  (cdr (assoc key alist :test #'equal)))
 keys :initial-value doc))  keys :initial-value doc))
(defmethod (setf at) (new-value (doc list) key &rest more-keys) (defmethod (setf at) (new-value (doc list) key &rest more-keys)
 (if more-keys  (if more-keys
 (setf (cdr (assoc (car (last more-keys))  (setf (cdr (assoc (car (last more-keys))
 (apply #'at doc key (butlast more-keys))  (apply #'at doc key (butlast more-keys))
 :test #'equal))  :test #'equal))
 new-value)  new-value)
 (setf (cdr (assoc key doc :test #'equal)) new-value)))  (setf (cdr (assoc key doc :test #'equal)) new-value)))
;; A playful alias. ;; A playful alias.
(defun @ (doc &rest keys) (defun @ (doc &rest keys)
 (apply #'at doc keys))  (apply #'at doc keys))
(defun (setf @) (new-value doc key &rest more-keys) (defun (setf @) (new-value doc key &rest more-keys)
 (apply #'(setf at) new-value doc key more-keys))  (apply #'(setf at) new-value doc key more-keys))