causa-arcana-misc/lesson-lisp
1
0
Fork 0
Code Activity

Extend and test lists lib

Browse source
This commit is contained in:
Alex Kotov 2023-05-08 15:48:56 +04:00
parent 2d62bca02b
commit 37cff92d0c
Signed by: kotovalexarian
GPG key ID: 553C0EBBEB5D5F08
3 changed files with 76 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
Makefile
View file

@ -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)

9
lib/lists.scm
View file

@ -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)))

66
tests/lists.scm Normal file
View file

@ -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))))