diff --git a/jekyll.el b/jekyll.el old mode 100755 new mode 100644 diff --git a/tools.el b/tools.el new file mode 100644 index 0000000..592dced --- /dev/null +++ b/tools.el @@ -0,0 +1,96 @@ +;; +;; Various tool functions & macros +;; + +(defmacro comment (&rest body) + "Ignores body, yields nil" + nil) + +;;;;;;; +;; Math + +(defun mean (values) + (/ (reduce '+ values) + (float (length values)))) + +(defun square (x) + (* x x)) + +(defun variance (values) + (- (->> values (mapcar 'square) mean) + (square (mean values)))) + +;;;;;;;;;;;; +;; Sequences + +(defun sequence (maybe-seq) + "Returns the value wrapped in a sequence if it is not a sequence already." + (if (sequencep maybe-seq) maybe-seq + (list maybe-seq))) + +(defun random-elt (sequence) + (elt sequence + (-> sequence length random))) + +(defun seq-difference (lseq rseq) + (remove-if (lambda (element) (find element rseq :test 'equal)) + lseq)) + +;;;;;;;;;; +;; Strings + +(defun string-empty-p (str) + (unless (stringp str) + (error "not a string.")) + (string= "" str)) + +(defun string-not-blank-p (str) + (when str + (not (string-empty-p str)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Undestructive alist functions + +(defun alist-get (alist key &optional default) + (or (assoc-default key alist) + default)) + +(defun alist-remove (alist key) + "Doesn't change the original alist, returns a new one instead." + (remove-if (lambda (x) (equal key (car x))) + alist)) + +(defun alist-set (alist key value) + "Doesn't change the original alist, returns a new one instead." + (cons (cons key value) (alist-remove alist key))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Clojure's Trush operators + +(defmacro -> (result &rest body) + (dolist (form body result) + (setq form (sequence form) + result (append (list (car form) result) + (cdr form))))) + +(defmacro ->> (result &rest body) + (dolist (form body result) + (setq form (sequence form) + result (append form (list result))))) + +;;;;;;;;;;;;;;;;;;;; +;; Functional tools + +(defmacro partial (f &rest args) + `(lambda (&rest more) + (apply ',f ,@args more))) + +(defmacro lexdef (name args &rest body) + "Defun with lexically-scoped parameters. Could also be called lexical-defun." + `(defun ,name ,args + (lexical-let ,(->> args + (remove-if (partial equal '&rest)) + (mapcar (lambda (arg) (list arg arg)))) + ,@body))) + +(provide 'tools) diff --git a/tools.elk b/tools.elk new file mode 100644 index 0000000..096a992 --- /dev/null +++ b/tools.elk @@ -0,0 +1,130 @@ +;; +;; +;; + +(require 'tools) + +(deftest "seq returns the sequence itself" + (assert-equal '(1) + (seq '(1))) + (assert-equal [1] + (seq [1])) + (assert-equal "1" + (seq "1"))) + +(deftest "seq turns non-sequences into a list" + (assert-equal '(1) + (seq 1)) + (assert-equal '(toto) + (seq 'toto))) + +(deftest "currying the plus function" + (assert-equal 5 + (funcall (partial + 2) 3))) + +(deftest "using curry in map" + (assert-equal [2 4 6] + (map 'vector (partial * 2) [1 2 3]))) + +(deftest "using curry in filter" + (assert-equal [2 3] + (remove-if-not (partial < 1) [1 2 3]))) + +(deftest "applying trush to one form" + (assert-equal 5.0 + (-> 25 sqrt))) + +(deftest "applying trush to two forms" + (assert-equal 3.0 + (-> 25 sqrt (- 2)))) + +(deftest "chaining trush combinators" + (assert-equal "-2.0" + (-> 25 sqrt (->> (- 3) number-to-string)))) + +(deftest "threading three forms" + (assert-equal '(* 6 (+ 4 5 (- 2 3 x))) + (macroexpand '(->> x (- 2 3) (+ 4 5) (* 6))))) + +(lexdef lexdef-test (x) + (lambda () x)) + +(defun defun-test (x) + (lambda () x)) + +(deftest "lexdef has lexical scoping" + (let ((lexical (lexdef-test 1)) + (dynamic (defun-test 1)) + (x 2)) + (assert-equal 1 + (funcall lexical)) + (assert-equal 2 + (funcall dynamic)))) + +(deftest "comment returns nil" + (assert-equal nil + (comment 3))) + +(deftest "comment does nothing" + (let ((x 1)) + (setq x 2) + (comment + (setq x 3)) + (assert-equal 2 x))) + +(deftest "variance of a const list returns 0" + (->> [[1 1 1] + [2 2 2 2 2] + [3 3 3 3 3 3 3]] + (mapcar (lambda (v) + (assert-equal 0.0 (variance v)))))) + +(deftest "variance of a simple list" + (assert-that (lambda (x) (< (eval x) 0.001)) + (- (/ 2 3.0) + (variance [1 2 3])))) + +(deftest "retrieving a random element" + (assert-equal "ABC" + (random-elt ["ABC"]))) + +(deftest "I can substract two vectors" + (assert-equal ["ABC"] + (seq-difference ["ABC" "DEF"] ["DEF"]))) + +;;; +;; Alist functions + +(deftest "I can get a value by key in an alist" + (let ((h '((a . 1)(b . 2)))) + (assert-equal 1 + (alist-get h 'a)) + (assert-equal 2 + (alist-get h 'b)) + (assert-nil (alist-get h 'z)) + (assert-equal 26 + (alist-get h 'z 26)))) + +(deftest "I can remove a value in an alist" + (let ((h '((a . 1)(b . 2)(a . 3)))) + (assert-nil (-> h (alist-remove 'a) (alist-get 'a))))) + +(deftest "I can set a value in an alist" + (let ((h '((a . 1)(b . 2)(a . 3)))) + (assert-equal '((a . 5)(b . 2)) (-> h (alist-set 'a 5))) + (assert-equal '((a . 1)(b . 2)(a . 3)) h))) + +;;;;;;;;;; +;; Strings + +(deftest "an empty string is empty, a non empty string is not empty" + (assert-nil (string-empty-p "hello")) + (assert-nonnil (string-empty-p (copy-seq ""))) + (assert-error "string" (string-empty-p 1)) + (assert-error "string" (string-empty-p nil))) + +(deftest "I can tell if a sring is blank" + (assert-t (string-not-blank-p "hello")) + (assert-nil (string-not-blank-p nil)) + (assert-nil (string-not-blank-p "")) + (assert-error "string" (string-not-blank-p 1)))