From 22af18dd1814ab0cb18e82049e8651719a4900d6 Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Thu, 24 Aug 2017 21:29:33 +0900 Subject: [PATCH] adding (srfi 116) --- lib/srfi/1/immutable.sld | 82 ++++++++++ lib/srfi/116.sld | 142 ++++++++++++++++ lib/srfi/116/test.sld | 338 +++++++++++++++++++++++++++++++++++++++ tests/lib-tests.scm | 2 + 4 files changed, 564 insertions(+) create mode 100644 lib/srfi/1/immutable.sld create mode 100644 lib/srfi/116.sld create mode 100644 lib/srfi/116/test.sld diff --git a/lib/srfi/1/immutable.sld b/lib/srfi/1/immutable.sld new file mode 100644 index 00000000..1f05b69d --- /dev/null +++ b/lib/srfi/1/immutable.sld @@ -0,0 +1,82 @@ + +(define-library (srfi 1 immutable) + (export + caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr + cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr + caaar caadr cadar caddr cdaar cdadr cddar cdddr + caar cadr cdar cddr car cdr + pair? list? + list-ref length apply map for-each member memv memq assoc assv assq + cons list xcons cons* make-list list-tabulate list-copy circular-list iota + proper-list? circular-list? dotted-list? not-pair? null-list? list= + first second third fourth fifth sixth seventh eighth ninth tenth + car+cdr take drop take-right drop-right split-at + last last-pair length+ concatenate append-reverse append reverse + zip unzip1 unzip2 unzip3 unzip4 unzip5 count + fold unfold pair-fold reduce fold-right unfold-right + pair-fold-right reduce-right + append-map pair-for-each filter-map map-in-order + filter partition remove find find-tail any every + list-index take-while drop-while span break + delete delete-duplicates + alist-cons alist-copy alist-delete + lset<= lset= lset-adjoin lset-union lset-intersection + lset-difference lset-xor lset-diff+intersection) + (import (rename (chibi) + (cons mcons) + (list mlist) + (reverse mreverse) + (append mappend) + (map mmap)) + (scheme cxr) + (only (chibi ast) make-immutable!)) + (begin + (define (cons a b) + (let ((res (mcons a b))) + (make-immutable! res) + res)) + (define (list . args) + (let lp ((ls args)) + (cond + ((pair? ls) + (make-immutable! ls) + (lp (cdr ls))))) + args) + (define (reverse ls) + (let lp ((ls ls) (res '())) + (if (pair? ls) + (lp (cdr ls) (cons (car ls) res)) + res))) + (define (append2 ls1 ls2) + (let lp ((ls1 (reverse ls1)) (ls2 ls2)) + (if (pair? ls1) + (lp (cdr ls1) (cons (car ls1) ls2)) + ls2))) + (define (append . o) + (let lp ((lol (reverse o)) (res '())) + (if (pair? lol) + (lp (cdr lol) (append2 (car lol) res)) + res))) + (define (map proc ls . lol) + (define (map1 proc ls res) + (if (pair? ls) + (map1 proc (cdr ls) (cons (proc (car ls)) res)) + (reverse res))) + (define (mapn proc lol res) + (if (every pair? lol) + (mapn proc + (map1 cdr lol '()) + (cons (apply proc (map1 car lol '())) res)) + (reverse res))) + (if (null? lol) + (map1 proc ls '()) + (mapn proc (cons ls lol) '())))) + (include "predicates.scm" + "selectors.scm" + "search.scm" + "misc.scm" + "constructors.scm" + "fold.scm" + "deletion.scm" + "alists.scm" + "lset.scm")) diff --git a/lib/srfi/116.sld b/lib/srfi/116.sld new file mode 100644 index 00000000..ad0a659d --- /dev/null +++ b/lib/srfi/116.sld @@ -0,0 +1,142 @@ + +(define-library (srfi 116) + (export + ;; Syntax + iq + + ;; Constructors + ipair ilist + xipair ipair* make-ilist ilist-tabulate + ilist-copy iiota + + ;; Predicates + ipair? proper-ilist? ilist? dotted-ilist? + not-ipair? null-ilist? + ilist= + + ;; Selectors + icar icdr icaar icadr icdar icddr + icaaaar icaaadr icaadar icaaddr + icadaar icadadr icaddar icadddr + icdaaar icdaadr icdadar icdaddr + icddaar icddadr icdddar icddddr + icaaar icaadr icadar icaddr + icdaar icdadr icddar icdddr + ilist-ref + ifirst isecond ithird ifourth ififth isixth iseventh ieighth ininth itenth + icar+icdr + itake idrop ilist-tail + itake-right idrop-right + isplit-at + ilast last-ipair + + ;; Miscellaneous: length, append, concatenate, reverse, zip & count + ilength + iappend iconcatenate ireverse iappend-reverse + izip iunzip1 iunzip2 iunzip3 iunzip4 iunzip5 + icount + + ;; Fold, unfold & map + imap ifor-each + ifold iunfold ipair-fold ireduce + ifold-right iunfold-right ipair-fold-right ireduce-right + iappend-map ipair-for-each ifilter-map imap-in-order + + ;; Filtering & partitioning + ifilter ipartition iremove + + ;; Searching + imember imemq imemv + ifind ifind-tail + iany ievery + ilist-index + itake-while idrop-while + ispan ibreak + + ;; Deleting + idelete idelete-duplicates + + ;; Immutable association lists + iassoc iassq iassv + ialist-cons ialist-delete + + ;; Replacement + replace-icar replace-icdr + + ;; Conversion + pair->ipair ipair->pair + list->ilist ilist->list + tree->itree itree->tree + gtree->itree gtree->tree + + ;; Procedure application + iapply + + ;; Comparators + ipair-comparator ilist-comparator + make-ilist-comparator make-improper-ilist-comparator + make-icar-comparator make-icdr-comparator) + + (import (scheme base) + (rename (prefix (srfi 1 immutable) i) + (imake-list make-ilist) + (icar+cdr icar+icdr) + (ilast-pair last-ipair) + (icons ipair) + (ixcons xipair) + (icons* ipair*) + (inull-list? null-ilist?) + (idotted-list? dotted-ilist?) + (iproper-list? proper-ilist?)) + (rename (srfi 128) + (make-pair-comparator make-ipair-comparator) + (make-list-comparator make-ilist-comparator))) + + (begin + (define-syntax iq + (syntax-rules () + ((iq x ...) + (ilist 'x ...)))) + (define (pair->ipair x) + (ipair (car x) (cdr x))) + (define (ipair->pair x) + (cons (car x) (cdr x))) + (define (not-ipair? x) + (not (ipair? x))) + (define (replace-icar x obj) + (ipair obj (cdr x))) + (define (replace-icdr x obj) + (ipair (car x) obj)) + (define ilist-tail idrop) + (define list->ilist ilist-copy) + (define ilist->list list-copy) + (define (tree->itree x) + (if (pair? x) + (ipair (tree->itree (car x)) (tree->itree (cdr x))) + x)) + (define (itree->tree x) + (if (ipair? x) + (cons (itree->tree (car x)) (itree->tree (cdr x))) + x)) + (define gtree->itree tree->itree) + (define gtree->tree itree->tree) + + (define ipair-comparator (make-default-comparator)) + (define ilist-comparator (make-default-comparator)) + (define make-improper-ilist-comparator make-ilist-comparator) + (define (make-field-comparator comparator pred field) + (make-comparator + (lambda (x) + (and (pred x) + ((comparator-type-test-predicate comparator) (field x)))) + (lambda (x y) + ((comparator-equality-predicate comparator) (field x) (field y))) + (lambda (x y) + ((comparator-ordering-predicate comparator) (field x) (field y))) + (lambda (x) + ((comparator-hash-function comparator) (field x))))) + (define (make-icar-comparator comparator) + (make-field-comparator comparator ipair? icar)) + (define (make-icdr-comparator comparator) + (make-field-comparator comparator ipair? icdr)) + )) diff --git a/lib/srfi/116/test.sld b/lib/srfi/116/test.sld new file mode 100644 index 00000000..51c88e6f --- /dev/null +++ b/lib/srfi/116/test.sld @@ -0,0 +1,338 @@ + +(define-library (srfi 116 test) + (import (scheme base) (srfi 116) (chibi test)) + (export run-tests) + (begin + (define (run-tests) + (test-group "ilists" + + (test-group "ilists/constructors" + (define abc (ilist 'a 'b 'c)) + (define abc-dot-d (ipair* 'a 'b 'c 'd)) + (define abc-copy (ilist-copy abc)) + (test 'a (icar abc)) + (test 'b (icadr abc)) + (test 'c (icaddr abc)) + (test (ipair 2 1) (xipair 1 2)) + (test 'd (icdddr abc-dot-d)) + (test (iq c c c c) (make-ilist 4 'c)) + (test (iq 0 1 2 3) (ilist-tabulate 4 values)) + (test (iq 0 1 2 3 4) (iiota 5)) + (test abc abc-copy) + (test-assert (not (eq? abc abc-copy)))) + + (test-group "ilists/predicates" + (test-assert (ipair? (ipair 1 2))) + (test-assert (proper-ilist? '())) + (test-assert (proper-ilist? (iq 1 2 3))) + (test-assert (ilist? '())) + (test-assert (ilist? (iq 1 2 3))) + (test-assert (dotted-ilist? (ipair 1 2))) + (test-assert (dotted-ilist? 2)) + (test-assert (null-ilist? '())) + (test-assert (not (null-ilist? (iq 1 2 3)))) + ;;(test-error (null-ilist? 'a)) + (test-assert (not-ipair? 'a)) + (test-assert (not (not-ipair? (ipair 'a 'b)))) + (test-assert (ilist= = (iq 1 2 3) (iq 1 2 3))) + (test-assert (ilist= = (iq 1 2 3) (iq 1 2 3) (iq 1 2 3))) + (test-assert (not (ilist= = (iq 1 2 3 4) (iq 1 2 3)))) + (test-assert (not (ilist= = (iq 1 2 3) (iq 1 2 3 4)))) + (test-assert (ilist= = (iq 1 2 3) (iq 1 2 3))) + (test-assert (not (ilist= = (iq 1 2 3) (iq 1 2 3 4) (iq 1 2 3 4)))) + (test-assert (not (ilist= = (iq 1 2 3) (iq 1 2 3) (iq 1 2 3 4))))) + + (test-group "ilist/cxrs" + (define ab (ipair 'a 'b)) + (define cd (ipair 'c 'd)) + (define ef (ipair 'e 'f)) + (define gh (ipair 'g 'h)) + (define abcd (ipair ab cd)) + (define efgh (ipair ef gh)) + (define abcdefgh (ipair abcd efgh)) + (define ij (ipair 'i 'j)) + (define kl (ipair 'k 'l)) + (define mn (ipair 'm 'n)) + (define op (ipair 'o 'p)) + (define ijkl (ipair ij kl)) + (define mnop (ipair mn op)) + (define ijklmnop (ipair ijkl mnop)) + (define abcdefghijklmnop (ipair abcdefgh ijklmnop)) + (test 'a (icaar abcd)) + (test 'b (icdar abcd)) + (test 'c (icadr abcd)) + (test 'd (icddr abcd)) + (test 'a (icaaar abcdefgh)) + (test 'b (icdaar abcdefgh)) + (test 'c (icadar abcdefgh)) + (test 'd (icddar abcdefgh)) + (test 'e (icaadr abcdefgh)) + (test 'f (icdadr abcdefgh)) + (test 'g (icaddr abcdefgh)) + (test 'h (icdddr abcdefgh)) + (test 'a (icaaaar abcdefghijklmnop)) + (test 'b (icdaaar abcdefghijklmnop)) + (test 'c (icadaar abcdefghijklmnop)) + (test 'd (icddaar abcdefghijklmnop)) + (test 'e (icaadar abcdefghijklmnop)) + (test 'f (icdadar abcdefghijklmnop)) + (test 'g (icaddar abcdefghijklmnop)) + (test 'h (icdddar abcdefghijklmnop)) + (test 'i (icaaadr abcdefghijklmnop)) + (test 'j (icdaadr abcdefghijklmnop)) + (test 'k (icadadr abcdefghijklmnop)) + (test 'l (icddadr abcdefghijklmnop)) + (test 'm (icaaddr abcdefghijklmnop)) + (test 'n (icdaddr abcdefghijklmnop)) + (test 'o (icadddr abcdefghijklmnop)) + (test 'p (icddddr abcdefghijklmnop))) + + (test-group "ilists/selectors" + (define ten (ilist 1 2 3 4 5 6 7 8 9 10)) + (define abcde (iq a b c d e)) + (define dotted (ipair 1 (ipair 2 (ipair 3 'd)))) + (test 'c (ilist-ref (iq a b c d) 2)) + (test 1 (ifirst ten)) + (test 2 (isecond ten)) + (test 3 (ithird ten)) + (test 4 (ifourth ten)) + (test 5 (ififth ten)) + (test 6 (isixth ten)) + (test 7 (iseventh ten)) + (test 8 (ieighth ten)) + (test 9 (ininth ten)) + (test 10 (itenth ten)) + (test-error (ilist-ref '() 2)) + (test '(1 2) (call-with-values (lambda () (icar+icdr (ipair 1 2))) list)) + (test (iq a b) (itake abcde 2)) + (test (iq c d e) (idrop abcde 2)) + (test (iq c d e) (ilist-tail abcde 2)) + (test (iq 1 2) (itake dotted 2)) + (test (ipair 3 'd) (idrop dotted 2)) + (test (ipair 3 'd) (ilist-tail dotted 2)) + (test 'd (idrop dotted 3)) + (test 'd (ilist-tail dotted 3)) + (test abcde (iappend (itake abcde 4) (idrop abcde 4))) + (test (iq d e) (itake-right abcde 2)) + (test (iq a b c) (idrop-right abcde 2)) + (test (ipair 2 (ipair 3 'd)) (itake-right dotted 2)) + (test (iq 1) (idrop-right dotted 2)) + (test 'd (itake-right dotted 0)) + (test (iq 1 2 3) (idrop-right dotted 0)) + (test abcde (call-with-values (lambda () (isplit-at abcde 3)) iappend)) + (test 'c (ilast (iq a b c))) + (test (iq c) (last-ipair (iq a b c)))) + + (test-group "ilists/misc" + (test 0 (ilength '())) + (test 3 (ilength (iq 1 2 3))) + (test (iq x y) (iappend (iq x) (iq y))) + (test (iq a b c d) (iappend (iq a b) (iq c d))) + (test (iq a) (iappend '() (iq a))) + (test (iq x y) (iappend (iq x y))) + (test '() (iappend)) + (test (iq a b c d) (iconcatenate (iq (a b) (c d)))) + (test (iq c b a) (ireverse (iq a b c))) + (test (iq (e (f)) d (b c) a) (ireverse (iq a (b c) d (e (f))))) + (test (ipair 2 (ipair 1 'd)) (iappend-reverse (iq 1 2) 'd)) + (test (iq (one 1 odd) (two 2 even) (three 3 odd)) + (izip (iq one two three) (iq 1 2 3) (iq odd even odd))) + (test (iq (1) (2) (3)) (izip (iq 1 2 3))) + (test (iq 1 2 3) (iunzip1 (iq (1) (2) (3)))) + (test (iq (1 2 3) (one two three)) + (call-with-values + (lambda () (iunzip2 (iq (1 one) (2 two) (3 three)))) + ilist)) + (test (iq (1 2 3) (one two three) (a b c)) + (call-with-values + (lambda () (iunzip3 (iq (1 one a) (2 two b) (3 three c)))) + ilist)) + (test (iq (1 2 3) (one two three) (a b c) (4 5 6)) + (call-with-values + (lambda () (iunzip4 (iq (1 one a 4) (2 two b 5) (3 three c 6)))) + ilist)) + (test (iq (1 2 3) (one two three) (a b c) (4 5 6) (#t #f #t)) + (call-with-values + (lambda () (iunzip5 (iq (1 one a 4 #t) (2 two b 5 #f) (3 three c 6 #t)))) + ilist)) + (test 3 (icount even? (iq 3 1 4 1 5 9 2 5 6))) + (test 3 (icount < (iq 1 2 4 8) (iq 2 4 6 8 10 12 14 16)))) + + (test-group "ilists/folds" + ;; We have to be careful to test both single-list and multiple-list + ;; code paths, as they are different in this implementation. + (define squares (iq 1 4 9 16 25 36 49 64 81 100)) + (define lis (iq 1 2 3)) + (define (z x y ans) (ipair (ilist x y) ans)) + (define z2 (let ((count 0)) (lambda (ignored) (set! count (+ count 1)) count))) + (test 6 (ifold + 0 lis)) + (test (iq 3 2 1) (ifold ipair '() lis)) + (test 2 (ifold + (lambda (x count) (if (symbol? x) (+ count 1) count)) + 0 + (iq a 0 b))) + (test 4 (ifold + (lambda (s max-len) (max max-len (string-length s))) + 0 + (iq "ab" "abcd" "abc"))) + (test 32 (ifold + (lambda (a b ans) (+ (* a b) ans)) + 0 + (iq 1 2 3) + (iq 4 5 6))) + (test (iq (b d) (a c)) + (ifold z '() (iq a b) (iq c d))) + (test lis (ifold-right ipair '() lis)) + (test (iq 0 2 4) (ifold-right + (lambda (x l) (if (even? x) (ipair x l) l)) + '() + (iq 0 1 2 3 4))) + (test (iq (a c) (b d)) + (ifold-right z '() (iq a b) (iq c d))) + (test (iq (c) (b c) (a b c)) + (ipair-fold ipair '() (iq a b c))) + (test (iq ((b) (d)) ((a b) (c d))) + (ipair-fold z '() (iq a b) (iq c d))) + (test (iq (a b c) (b c) (c)) + (ipair-fold-right ipair '() (iq a b c))) + (test (iq ((a b) (c d)) ((b) (d))) + (ipair-fold-right z '() (iq a b) (iq c d))) + (test 5 (ireduce max 0 (iq 1 3 5 4 2 0))) + (test 1 (ireduce - 0 (iq 1 2))) + (test -1 (ireduce-right - 0 (iq 1 2))) + (test squares + (iunfold (lambda (x) (> x 10)) + (lambda (x) (* x x)) + (lambda (x) (+ x 1)) + 1)) + (test squares + (iunfold-right zero? + (lambda (x) (* x x)) + (lambda (x) (- x 1)) + 10)) + (test (iq 1 2 3) (iunfold null-ilist? icar icdr (iq 1 2 3))) + (test (iq 3 2 1) (iunfold-right null-ilist? icar icdr (iq 1 2 3))) + (test (iq 1 2 3 4) + (iunfold null-ilist? icar icdr (iq 1 2) (lambda (x) (iq 3 4)))) + (test (iq b e h) (imap icadr (iq (a b) (d e) (g h)))) + (test (iq b e h) (imap-in-order icadr (iq (a b) (d e) (g h)))) + (test (iq 5 7 9) (imap + (iq 1 2 3) (iq 4 5 6))) + (test (iq 5 7 9) (imap-in-order + (iq 1 2 3) (iq 4 5 6))) + (test (iq 1 2) (imap-in-order z2 (iq a b))) + (test '#(0 1 4 9 16) + (let ((v (make-vector 5))) + (ifor-each (lambda (i) + (vector-set! v i (* i i))) + (iq 0 1 2 3 4)) + v)) + (test '#(5 7 9 11 13) + (let ((v (make-vector 5))) + (ifor-each (lambda (i j) + (vector-set! v i (+ i j))) + (iq 0 1 2 3 4) + (iq 5 6 7 8 9)) + v)) + (test (iq 1 -1 3 -3 8 -8) + (iappend-map (lambda (x) (ilist x (- x))) (iq 1 3 8))) + (test (iq 1 4 2 5 3 6) + (iappend-map ilist (iq 1 2 3) (iq 4 5 6))) + (test (vector (iq 0 1 2 3 4) (iq 1 2 3 4) (iq 2 3 4) (iq 3 4) (iq 4)) + (let ((v (make-vector 5))) + (ipair-for-each (lambda (lis) (vector-set! v (icar lis) lis)) (iq 0 1 2 3 4)) + v)) + (test (vector (iq 5 6 7 8 9) (iq 6 7 8 9) (iq 7 8 9) (iq 8 9) (iq 9)) + (let ((v (make-vector 5))) + (ipair-for-each (lambda (i j) (vector-set! v (icar i) j)) + (iq 0 1 2 3 4) + (iq 5 6 7 8 9)) + v)) + (test (iq 1 9 49) + (ifilter-map (lambda (x) (and (number? x) (* x x))) (iq a 1 b 3 c 7))) + (test (iq 5 7 9) + (ifilter-map + (lambda (x y) (and (number? x) (number? y) (+ x y))) + (iq 1 a 2 b 3 4) + (iq 4 0 5 y 6 z2)))) + + (test-group "ilists/filtering" + (test (iq 0 8 8 -4) (ifilter even? (iq 0 7 8 8 43 -4))) + (test (list (iq one four five) (iq 2 3 6)) + (call-with-values + (lambda () (ipartition symbol? (iq one 2 3 four five 6))) + list)) + (test (iq 7 43) (iremove even? (iq 0 7 8 8 43 -4)))) + + (test-group "ilists/searching" + (test 2 (ifind even? (iq 1 2 3))) + (test #t (iany even? (iq 1 2 3))) + (test #f (ifind even? (iq 1 7 3))) + (test #f (iany even? (iq 1 7 3))) + ;;(test-error (ifind even? (ipair 1 (ipair 3 'x)))) + ;;(test-error (iany even? (ipair 1 (ipair 3 'x)))) + (test 4 (ifind even? (iq 3 1 4 1 5 9))) + (test (iq -8 -5 0 0) (ifind-tail even? (iq 3 1 37 -8 -5 0 0))) + (test (iq 2 18) (itake-while even? (iq 2 18 3 10 22 9))) + (test (iq 3 10 22 9) (idrop-while even? (iq 2 18 3 10 22 9))) + (test (list (iq 2 18) (iq 3 10 22 9)) + (call-with-values + (lambda () (ispan even? (iq 2 18 3 10 22 9))) + list)) + (test (list (iq 3 1) (iq 4 1 5 9)) + (call-with-values + (lambda () (ibreak even? (iq 3 1 4 1 5 9))) + list)) + (test #t (iany integer? (iq a 3 b 2.7))) + (test #f (iany integer? (iq a 3.1 b 2.7))) + (test #t (iany < (iq 3 1 4 1 5) (iq 2 7 1 8 2))) + (test #t (ievery integer? (iq 1 2 3 4 5))) + (test #f (ievery integer? (iq 1 2 3 4.5 5))) + (test #t (ievery (lambda (a b) (< a b)) (iq 1 2 3) (iq 4 5 6))) + (test 2 (ilist-index even? (iq 3 1 4 1 5 9))) + (test 1 (ilist-index < (iq 3 1 4 1 5 9 2 5 6) (iq 2 7 1 8 2))) + (test #f (ilist-index = (iq 3 1 4 1 5 9 2 5 6) (iq 2 7 1 8 2))) + (test (iq a b c) (imemq 'a (iq a b c))) + (test (iq b c) (imemq 'b (iq a b c))) + (test #f (imemq 'a (iq b c d))) + (test #f (imemq (ilist 'a) (iq b (a) c))) + (test (iq (a) c) (imember (ilist 'a) (iq b (a) c))) + (test (iq 101 102) (imemv 101 (iq 100 101 102)))) + + (test-group "ilists/deletion" + (test (iq 1 2 4 5) (idelete 3 (iq 1 2 3 4 5))) + (test (iq 3 4 5) (idelete 5 (iq 3 4 5 6 7) <)) + (test (iq a b c z) (idelete-duplicates (iq a b a c a b c z)))) + + (test-group "ilists/alists" + (define e (iq (a 1) (b 2) (c 3))) + (define e2 (iq (2 3) (5 7) (11 13))) + (test (iq a 1) (iassq 'a e)) + (test (iq b 2) (iassq 'b e)) + (test #f (iassq 'd e)) + (test #f (iassq (ilist 'a) (iq ((a)) ((b)) ((c))))) + (test (iq (a)) (iassoc (ilist 'a) (iq ((a)) ((b)) ((c))))) + (test (iq 5 7) (iassv 5 e2)) + (test (iq 11 13) (iassoc 5 e2 <)) + (test (ipair (iq 1 1) e2) (ialist-cons 1 (ilist 1) e2)) + (test (iq (2 3) (11 13)) (ialist-delete 5 e2)) + (test (iq (2 3) (5 7)) (ialist-delete 5 e2 <)) + ) + + (test-group "ilists/replacers" + (test (ipair 1 3) (replace-icar (ipair 2 3) 1)) + (test (ipair 1 3) (replace-icdr (ipair 1 2) 3))) + + (test-group "ilists/conversion" + (test (ipair 1 2) (pair->ipair '(1 . 2))) + (test '(1 . 2) (ipair->pair (ipair 1 2))) + (test (iq 1 2 3) (list->ilist '(1 2 3))) + (test '(1 2 3) (ilist->list (iq 1 2 3))) + (test (ipair 1 (ipair 2 3)) (list->ilist '(1 2 . 3))) + (test '(1 2 . 3) (ilist->list (ipair 1 (ipair 2 3)))) + (test (ipair (ipair 1 2) (ipair 3 4)) (tree->itree '((1 . 2) . (3 . 4)))) + (test '((1 . 2) . (3 . 4)) (itree->tree (ipair (ipair 1 2) (ipair 3 4)))) + (test (ipair (ipair 1 2) (ipair 3 4)) (gtree->itree (cons (ipair 1 2) (ipair 3 4)))) + (test '((1 . 2) . (3 . 4)) (gtree->tree (cons (ipair 1 2) (ipair 3 4)))) + (test 6 (iapply + (iq 1 2 3))) + (test 15 (iapply + 1 2 (iq 3 4 5)))) + + )))) diff --git a/tests/lib-tests.scm b/tests/lib-tests.scm index a834dc0a..b96c1e13 100644 --- a/tests/lib-tests.scm +++ b/tests/lib-tests.scm @@ -11,6 +11,7 @@ (rename (srfi 69 test) (run-tests run-srfi-69-tests)) (rename (srfi 95 test) (run-tests run-srfi-95-tests)) (rename (srfi 99 test) (run-tests run-srfi-99-tests)) + (rename (srfi 116 test) (run-tests run-srfi-116-tests)) (rename (srfi 117 test) (run-tests run-srfi-117-tests)) (rename (srfi 121 test) (run-tests run-srfi-121-tests)) (rename (srfi 128 test) (run-tests run-srfi-128-tests)) @@ -61,6 +62,7 @@ (run-srfi-69-tests) (run-srfi-95-tests) (run-srfi-99-tests) +(run-srfi-116-tests) (run-srfi-117-tests) (run-srfi-121-tests) (run-srfi-128-tests)