Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 124 lines (96 sloc) 3.087 kb
53786533 »
2010-06-10 Added tools.el
1 ;;
2 ;; Various tool functions & macros
3 ;;
4
5 (defmacro comment (&rest body)
6 "Ignores body, yields nil"
7 nil)
8
9 ;;;;;;;
10 ;; Math
11
12 (defun mean (values)
13 (/ (reduce '+ values)
14 (float (length values))))
15
16 (defun square (x)
17 (* x x))
18
19 (defun variance (values)
20 (- (->> values (mapcar 'square) mean)
21 (square (mean values))))
22
23 ;;;;;;;;;;;;
24 ;; Sequences
25
26 (defun sequence (maybe-seq)
27 "Returns the value wrapped in a sequence if it is not a sequence already."
28 (if (sequencep maybe-seq) maybe-seq
29 (list maybe-seq)))
30
31 (defun random-elt (sequence)
32 (elt sequence
33 (-> sequence length random)))
34
35 (defun seq-difference (lseq rseq)
36 (remove-if (lambda (element) (find element rseq :test 'equal))
37 lseq))
38
39 ;;;;;;;;;;
40 ;; Strings
41
42 (defun string-empty-p (str)
3b1da061 »
2010-06-10 small tool changes
43 (if str
44 (string= "" str)
45 t))
53786533 »
2010-06-10 Added tools.el
46
3b1da061 »
2010-06-10 small tool changes
47 (defun string-not-empty-p (str)
48 (not (string-empty-p str)))
53786533 »
2010-06-10 Added tools.el
49
34e771cd »
2010-06-22 Added string-blank-p
50 (defun string-blank-p (str)
51 (if (string-empty-p str)
52 t
53 (not (null (string-match "^\\(?:\s*\n\\)*$" str)))))
54
55 (defun string-not-blank-p (str)
56 (not (string-blank-p str)))
57
53786533 »
2010-06-10 Added tools.el
58 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
59 ;; Undestructive alist functions
60
61 (defun alist-get (alist key &optional default)
62 (or (assoc-default key alist)
63 default))
64
65 (defun alist-remove (alist key)
66 "Doesn't change the original alist, returns a new one instead."
67 (remove-if (lambda (x) (equal key (car x)))
68 alist))
69
70 (defun alist-set (alist key value)
71 "Doesn't change the original alist, returns a new one instead."
72 (cons (cons key value) (alist-remove alist key)))
73
74 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
75 ;; Clojure's Trush operators
76
a309645f »
2010-06-15 Added nil safe combinators
77 (defmacro -> (x &optional form &rest more)
78 (cond ((not (null more))
79 `(-> (-> ,x ,form) ,@more))
80 ((not (null form))
81 (if (sequencep form)
82 `(,(first form) ,x ,@(rest form))
83 (list form x)))
84 (t x)))
85
86 (defmacro ->> (x form &rest more)
87 (cond ((not (null more)) `(->> (->> ,x ,form) ,@more))
88 (t (if (sequencep form)
89 `(,(first form) ,@(rest form) ,x)
90 (list form x)))))
91
92 (defmacro -?> (x form &rest more)
93 (cond ((not (null more)) `(-?> (-?> ,x ,form) ,@more))
94 (t (if (sequencep form)
95 `(if (null ,x) nil
96 (,(first form) ,x ,@(rest form)))
97 `(if (null ,x) nil
98 ,(list form x))))))
99
100 (defmacro -?>> (x form &rest more)
101 (cond ((not (null more)) `(-?>> (-?>> ,x ,form) ,@more))
102 (t (if (sequencep form)
103 `(if (null ,x) nil
104 (,(first form) ,@(rest form) ,x))
105 `(if (null ,x) nil
106 ,(list form x))))))
53786533 »
2010-06-10 Added tools.el
107
108 ;;;;;;;;;;;;;;;;;;;;
109 ;; Functional tools
110
111 (defmacro partial (f &rest args)
112 `(lambda (&rest more)
113 (apply ',f ,@args more)))
114
115 (defmacro lexdef (name args &rest body)
116 "Defun with lexically-scoped parameters. Could also be called lexical-defun."
117 `(defun ,name ,args
118 (lexical-let ,(->> args
119 (remove-if (partial equal '&rest))
120 (mapcar (lambda (arg) (list arg arg))))
121 ,@body)))
122
123 (provide 'tools)
Something went wrong with that request. Please try again.