maurice/snix
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Squashed 'third_party/lisp/quasiquote_2/' content from commit cac90875d1

Browse source 
git-subtree-dir: third_party/lisp/quasiquote_2
git-subtree-split: cac90875d1f66e9385e559bfebafe6b7808b0930
This commit is contained in:
Vincent Ambo 2020-01-22 21:38:16 +00:00
commit 47f60d0996
8 changed files with 895 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

143
tests.lisp Normal file
View file

@ -0,0 +1,143 @@
(in-package :cl-user)
(defpackage :quasiquote-2.0-tests
(:use :cl :quasiquote-2.0 :fiveam)
(:export #:run-tests))
(in-package :quasiquote-2.0-tests)
(def-suite quasiquote-2.0)
(in-suite quasiquote-2.0)
(defun run-tests ()
(let ((results (run 'quasiquote-2.0)))
(fiveam:explain! results)
(unless (fiveam:results-status results)
(error "Tests failed."))))
(test basic
(is (equal '(nil :just-quote-it!) (multiple-value-list (%codewalk-dig-form '(dig nil)))))
(is (equal '(nil :just-form-it!) (multiple-value-list (%codewalk-dig-form '(dig (inject a))))))
(is (equal '(nil :just-form-it!) (multiple-value-list (%codewalk-dig-form '(dig 2 (inject 2 a))))))
(is (equal '(((((inject b) c (inject d)) car cdr car) (((inject d)) car cdr cdr cdr car)) nil)
(multiple-value-list (%codewalk-dig-form '(dig (a (inject b) c (inject d)))))))
(is (equal '(nil nil)
(multiple-value-list (%codewalk-dig-form '(dig (dig (a (inject b) c (inject d))))))))
(is (equal '(((((inject 2 d)) car cdr cdr cdr car cdr car)) nil)
(multiple-value-list (%codewalk-dig-form '(dig (dig (a (inject b) c (inject 2 d)))))))))
(test transform
(is (equal '(quote a) (transform-dig-form '(dig a))))
(is (equal '(quote a) (transform-dig-form '(dig 2 a))))
(is (equal 'a (transform-dig-form '(dig (inject a)))))
(is (equal 'a (transform-dig-form '(dig 2 (inject 2 a))))))
(defun foo (b d)
(dig (a (inject b) c (inject d))))
(defun foo1-transparent (x)
(declare (ignorable x))
(dig (dig (a (inject (b (inject x) c))))))
(defun foo1-opaque (x)
(declare (ignorable x))
(dig (dig (a (oinject (b (inject x) c))))))
(defun foo-recursive (x y)
(dig (a (inject (list x (dig (c (inject y))))))))
(test foos
(is (equal '(a 1 c 2) (foo 1 2)))
(is (equal '(a 100 c 200) (foo 100 200))))
(test opaque-vs-transparent
(is (equal '(quote a) (transform-dig-form '(odig a))))
(is (equal '(quote a) (transform-dig-form '(odig 2 a))))
(is (equal 'a (transform-dig-form '(odig (inject a)))))
(is (equal 'a (transform-dig-form '(odig 2 (inject 2 a)))))
(is (equal '(odig (inject 2 a)) (eval (transform-dig-form '(dig (odig (inject 2 a)))))))
(is (equal '(dig (a (inject (b 3 c)))) (foo1-transparent 3)))
(is (equal '(dig (a (oinject (b (inject x) c)))) (foo1-opaque 3))))
(test recursive-compile-time
(is (equal '(a (1 (c 2))) (foo-recursive 1 2))))
(test splicing
(is (equal '(a b c d) (eval (transform-dig-form '(dig (a (splice '(b c)) d))))))
(is (equal '(b c d) (eval (transform-dig-form '(dig ((splice '(b c)) d))))))
(is (equal '(a b c) (eval (transform-dig-form '(dig (a (splice '(b c))))))))
(is (equal '(a b) (eval (transform-dig-form '(dig (a (splice nil) b))))))
(is (equal '(b) (eval (transform-dig-form '(dig ((splice nil) b))))))
(is (equal '(a) (eval (transform-dig-form '(dig (a (splice nil)))))))
(is (equal '() (eval (transform-dig-form '(dig ((splice nil)))))))
(is (equal '(a b) (eval (transform-dig-form '(dig ((splice '(a b)))))))))
(test are-they-macro
(is (not (equal '(dig (a b)) (macroexpand-1 '(dig (a b))))))
(is (not (equal '(odig (a b)) (macroexpand-1 '(odig (a b)))))))
(defmacro triple-var (x)
`((inject ,x) (inject ,x) (inject ,x)))
(test correct-order-of-effects
(is (equal '(a 1 2 3) (let ((x 0))
(dig (a (inject (incf x)) (inject (incf x)) (inject (incf x)))))))
(is (equal '(a (((1))) 2)
(let ((x 0))
(dig (a ((((inject (incf x))))) (inject (incf x))))))))
(test macro-injects
(is (equal '(a (3 3 3)) (let ((x 3))
(dig (a (macro-inject (triple-var x)))))))
(is (equal '(a (1 2 3)) (let ((x 0))
(dig (a (macro-inject (triple-var (incf x))))))))
(macrolet ((frob (form n)
(mapcar (lambda (x)
`(inject ,x))
(make-list n :initial-element form)))
(frob1 (form)
`(frob ,form 4)))
(is (equal '(a (1 2 3 4 5))
(let ((x 0))
(dig (a (macro-inject (frob (incf x) 5)))))))
(is (equal '(a 1 2 3 4 5)
(let ((x 0))
(dig (a (macro-splice (frob (incf x) 5)))))))
(is (equal '(a)
(let ((x 0))
(declare (ignorable x))
(dig (a (macro-splice (frob (incf x) 0)))))))
(is (equal '(a frob (incf x) 4)
(let ((x 0))
(declare (ignorable x))
(dig (a (macro-splice (frob1 (incf x))))))))
(is (equal '(a 1 2 3 4)
(let ((x 0))
(dig (a (macro-splice-all (frob1 (incf x))))))))))
(quasiquote-2.0:enable-quasiquote-2.0)
(test reader
(is (equal '(inject x) ',x))
(is (equal '(inject 3 x) ',,,x))
(is (equal '(splice x) ',@x))
(is (equal '(splice 3 x) ',,,@x))
(is (equal '(omacro-splice-all 4 x) ',,,,!oma@x))
(is (equal '(inject 4 oma@x) ',,,,oma@x)))
(test macro-splices
(macrolet ((splicer (x)
``(splice ,x)))
(is (equal '(a 1 2 3) (let ((x '(1 2 3)))
`(a ,!m(splicer x)))))))
(test repeated-splices
(is (equal '(a) `(a ,@nil ,@nil ,@nil ,@nil)))
(is (equal '(a b c d e f g) `(a ,@(list 'b 'c) ,@(list 'd 'e) ,@nil ,@(list 'f 'g)))))