git.iko.soy/bat
on master help sign in
Add Common Lisp syntax highlighting test files
commit4b2b419400834ba82aae957b73f273e68eb4a669 authorBenjamin Sinkula <bsinky@gmail.com> dateThu 15 Oct 2020, 16:30 (6 years ago) parentb83716f
3 files changed+184
compare with master
unifiedsplit
tests/syntax-tests/highlighted/Lisp/utils.lisp+80 tests/syntax-tests/source/Lisp/LICENSE.md+24 tests/syntax-tests/source/Lisp/utils.lisp+80
tests/syntax-tests/highlighted/Lisp/utils.lispnew file+80
@@ -0,0 +1,80 @@
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
35+returned by the second-to-last key.
36+tl;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))
tests/syntax-tests/source/Lisp/LICENSE.mdnew file+24
@@ -0,0 +1,24 @@
1+The `utils.lisp` file has been added from https://github.com/zkat/chillax under the following license:
2+
3+Copyright © 2009-2010 Kat Marchán
4+
5+Permission is hereby granted, free of charge, to any person
6+obtaining a copy of this software and associated documentation
7+files (the "Software"), to deal in the Software without
8+restriction, including without limitation the rights to use, copy,
9+modify, merge, publish, distribute, sublicense, and/or sell copies
10+of the Software, and to permit persons to whom the Software is
11+furnished to do so, subject to the following conditions:
12+
13+The above copyright notice and this permission notice shall be
14+included in all copies or substantial portions of the Software.
15+
16+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
17+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
18+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
19+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
20+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
21+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
22+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
23+DEALINGS IN THE SOFTWARE.
24+
tests/syntax-tests/source/Lisp/utils.lispnew file+80
@@ -0,0 +1,80 @@
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
35+returned by the second-to-last key.
36+tl;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))