diff --git a/Makefile b/Makefile index 8e67ab1..791dc79 100644 --- a/Makefile +++ b/Makefile @@ -35,6 +35,7 @@ test: arcana-lisp $(CAT) tests/arithm_ops.scm | ./arcana-lisp $(LIBS) $(CAT) tests/basic_data_structs.scm | ./arcana-lisp $(LIBS) $(CAT) tests/equiv.scm | ./arcana-lisp $(LIBS) + $(CAT) tests/lists.scm | ./arcana-lisp $(LIBS) $(CAT) tests/logic_ops.scm | ./arcana-lisp $(LIBS) $(CAT) tests/syntax.scm | ./arcana-lisp $(LIBS) $(CAT) tests/type_conv.scm | ./arcana-lisp $(LIBS) diff --git a/lib/lists.scm b/lib/lists.scm index ba9f4c0..86b9475 100644 --- a/lib/lists.scm +++ b/lib/lists.scm @@ -1,3 +1,12 @@ +(define (first x) (car x)) +(define (second x) (cadr x)) +(define (third x) (caddr x)) + +(define (last x) + (if (null? (cdr x)) + (car x) + (last (cdr x)))) + (define (caar x) (car (car x))) (define (cadr x) (car (cdr x))) (define (cdar x) (cdr (car x))) diff --git a/tests/lists.scm b/tests/lists.scm new file mode 100644 index 0000000..63f6a7f --- /dev/null +++ b/tests/lists.scm @@ -0,0 +1,66 @@ +;;; first ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(assert-equal 'a (first '(a))) +(assert-equal 'a (first '(a b))) +(assert-equal 'a (first '(a b c))) +(assert-equal 'a (first '(a b c d))) + +;;; second ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(assert-equal 'b (second '(a b))) +(assert-equal 'b (second '(a b c))) +(assert-equal 'b (second '(a b c d))) + +;;; third ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(assert-equal 'c (third '(a b c))) +(assert-equal 'c (third '(a b c d))) + +;;; last ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(assert-equal 'a (last '(a))) +(assert-equal 'b (last '(a b))) +(assert-equal 'c (last '(a b c))) +(assert-equal 'd (last '(a b c d))) + +;;; c(a|d){2}r ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(let + ([lst + '((a b) c d)]) + (begin + (assert-equal 'a (caar lst)) + (assert-equal '(b) (cdar lst)) + (assert-equal 'c (cadr lst)) + (assert-equal '(d) (cddr lst)))) + +;;; c(a|d){3}r ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(let + ([lst + '(((a b) c d) (e f) g h)]) + (begin + (assert-equal 'a (caaar lst)) + (assert-equal '(b) (cdaar lst)) + (assert-equal 'c (cadar lst)) + (assert-equal '(d) (cddar lst)) + (assert-equal 'e (caadr lst)) + (assert-equal '(f) (cdadr lst)) + (assert-equal 'g (caddr lst)) + (assert-equal '(h) (cdddr lst)))) + +;;; c(a|d){4}r ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(let + ([lst + '((((a b) c d) (e f) g h) ((i j) k l) (m n) o p)]) + (begin + (assert-equal 'a (caaaar lst)) + (assert-equal '(b) (cdaaar lst)) + (assert-equal 'c (cadaar lst)) + (assert-equal '(d) (cddaar lst)) + (assert-equal 'e (caadar lst)) + (assert-equal '(f) (cdadar lst)) + (assert-equal 'g (caddar lst)) + (assert-equal '(h) (cdddar lst)) + (assert-equal 'i (caaadr lst)) + (assert-equal '(j) (cdaadr lst)) + (assert-equal 'k (cadadr lst)) + (assert-equal '(l) (cddadr lst)) + (assert-equal 'm (caaddr lst)) + (assert-equal '(n) (cdaddr lst)) + (assert-equal 'o (cadddr lst)) + (assert-equal '(p) (cddddr lst))))