(import "test")
;;;
;;;  Sequence Functions
;;;

($ap 1 "Sequence Functions")

;;;
;;; function (LENGTH sequence) --> <integer>
;;;
($ap 2 "length" P.98)
($test (length '(a b c)) 3 eql)
($test (length '(a (b) (c d e))) 3 eql)
($test (length '()) 0 eql)
($test (length (vector 'a 'b 'c)) 3 eql)
;;;
($argc length 1 0 0)
($type length ($string $vector $cons $null) :target)
;;;
($test (length "") 0 eql)
($test (length "abc") 3 eql)
($test (length #()) 0 eql)
($test (length (create-string 1000)) 1000 eql)
($test (length (create-vector 1000)) 1000 eql)
($test (length (create-list 1000)) 1000 eql)

;;;
;;; function (ELT sequence z) --> <object>
;;;
($ap 2 "elt" P.99)
($test (elt '(a b c) 2) c)
($test (elt (vector 'a 'b 'c) 1) b)
($test (elt "abc" 0) #\a eql)
;;;
($argc elt 2 0 0)
($type elt ($string $vector $cons $null) :target 0)
($type elt ($integer) "abc" :target)
($type elt ($integer) #(a b c) :target)
($type elt ($integer) (quote (a b c)) :target)
;;; String
($error (elt "" 0) <program-error>)
($error (elt "" -1) <domain-error>)
($error (elt "" -1234567890) <domain-error>)
($error (elt "" 1234567890) <program-error>)
($test (elt " " 0) #\space eql)
($test (elt "abc" 2) #\c eql)
($error (elt "abc" 3) <program-error>)
($error (elt "abc" -1) <domain-error>)
($error (elt "abc" -1234567890) <domain-error>)
($error (elt "abc" 1234567890) <program-error>)
($test (elt (create-string 1000 #\a) 999) #\a eql)
;;; Vector
($error (elt #() 0) <program-error>)
($error (elt #() -1) <domain-error>)
($error (elt #() -1234567890) <domain-error>)
($error (elt #() 1234567890) <program-error>)
($test (elt #(a b c) 0) a)
($test (elt #(a b c) 2) c)
($error (elt #(a b c) 3) <program-error>)
($error (elt #(a b c) -1) <domain-error>)
($error (elt #(a b c) -1234567890) <domain-error>)
($error (elt #(a b c) 1234567890) <program-error>)
($test (elt (create-vector 1000 'a) 999) a)
;;; List
($error (elt () 0) <program-error>)
($error (elt () -1) <domain-error>)
($error (elt () -1234567890) <domain-error>)
($error (elt () 1234567890) <program-error>)
($test (elt '(a b c) 0) a)
($error (elt '(a b c) 3) <program-error>)
($error (elt '(a b c) 1234567890) <program-error>)
($test (elt (create-list 1000 'a) 999) a)
($test (let ((string (create-string 5 #\x)))
   (set-elt #\O string 2)
   string)
 "xxOxx"
 string=)
;;;
($argc set-elt 3 0 0)
($type set-elt ($character) :target "abc" 0)
($type set-elt ($string $vector $cons $null) #\a :target 0)
($type set-elt ($integer) #\a "abc" :target)
($type set-elt ($integer) (quote a) #(a b c) :target)
($type set-elt ($integer) (quote a) (quote (a b c)) :target)
;;; String
($error (setf (elt "" 0) #\a) <program-error>)
($error (setf (elt "" -1) #\a) <domain-error>)
($error (setf (elt "" -1234567890) #\a) <domain-error>)
($error (setf (elt "" 1234567890) #\a) <program-error>)
($error (set-elt #\a "" 0) <program-error>)
($error (set-elt #\a "" -1) <domain-error>)
($error (set-elt #\a "" -1234567890) <domain-error>)
($error (set-elt #\a "" 1234567890) <program-error>)
($test (let ((x "abc")) (list (setf (elt x 0) #\A) x)) (#\A "Abc") equal)
($test (let ((x "abc")) (list (setf (elt x 2) #\C) x)) (#\C "abC") equal)
($test (let ((x "abc")) (list (set-elt #\A x 0) x)) (#\A "Abc") equal)
($test (let ((x "abc")) (list (set-elt #\C x 2) x)) (#\C "abC") equal)
($error (setf (elt "abc" 3) #\a) <program-error>)
($error (setf (elt "abc" -1) #\a) <domain-error>)
($error (setf (elt "abc" -1234567890) #\a) <domain-error>)
($error (setf (elt "abc" 1234567890) #\a) <program-error>)
($error (set-elt #\a "abc" 3) <program-error>)
($error (set-elt #\a "abc" -1) <domain-error>)
($error (set-elt #\a "abc" -1234567890) <domain-error>)
($error (set-elt #\a "abc" 1234567890) <program-error>)
($test (let ((x "abc")) (list (setf (elt x 0) #\space) x)) (#\space " bc") equal)
($test (let ((x "abc")) (list (setf (elt x 2) #\space) x)) (#\space "ab ") equal)
($test (let ((x "abc")) (list (set-elt #\space x 0) x)) (#\space " bc") equal)
($test (let ((x "abc")) (list (set-elt #\space x 2) x)) (#\space "ab ") equal)
($test (let ((x (create-string 1000 #\a))) (list (setf (elt x 999) #\z) (elt x 999)))
 (#\z #\z)
 equal)
($test (let ((x (create-string 1000 #\a))) (list (set-elt #\z x 999) (elt x 999)))
 (#\z #\z)
 equal)
 
;;; Vector
($error (setf (elt #() 0) 'a) <program-error>)
($error (setf (elt #() -1) 'a) <domain-error>)
($error (setf (elt #() -1234567890) 'a) <domain-error>)
($error (setf (elt #() 1234567890) 'a) <program-error>)
($error (set-elt 'a #() 0) <program-error>)
($error (set-elt 'a #() -1) <domain-error>)
($error (set-elt 'a #() -1234567890) <domain-error>)
($error (set-elt 'a #() 1234567890) <program-error>)
($test (let ((x #(a b c))) (list (setf (elt x 0) 'z) x)) (z #(z b c)) equal)
($test (let ((x #(a b c))) (list (setf (elt x 2) 'z) x)) (z #(a b z)) equal)
($test (let ((x #(a b c))) (list (set-elt 'z x 0) x)) (z #(z b c)) equal)
($test (let ((x #(a b c))) (list (set-elt 'z x 2) x)) (z #(a b z)) equal)
($error (setf (elt #(a b c) 3) 'a) <program-error>)
($error (setf (elt #(a b c) -1) 'a) <domain-error>)
($error (setf (elt #(a b c) -1234567890) 'a) <domain-error>)
($error (setf (elt #(a b c) 1234567890) 'a) <program-error>)
($error (set-elt 'a #(a b c) 3) <program-error>)
($error (set-elt 'a #(a b c) -1) <domain-error>)
($error (set-elt 'a #(a b c) -1234567890) <domain-error>)
($error (set-elt 'a #(a b c) 1234567890) <program-error>)
($test (let ((x (create-vector 1000 'a))) (list (setf (elt x 999) 'z) (elt x 999))) (z z) equal)
($test (let ((x (create-vector 1000 'a))) (list (set-elt 'z x 999) (elt x 999))) (z z) equal)
;;; List
($error (setf (elt () 0) 'a) <program-error>)
($error (setf (elt () -1) 'a) <domain-error>)
($error (setf (elt () -1234567890) 'a) <domain-error>)
($error (setf (elt () 1234567890) 'a) <program-error>)
($error (set-elt 'a () 0) <program-error>)
($error (set-elt 'a () -1) <domain-error>)
($error (set-elt 'a () -1234567890) <domain-error>)
($error (set-elt 'a () 1234567890) <program-error>)
($error (setf (elt '(a b c) 3) 'a) <program-error>)
($error (setf (elt '(a b c) -1) 'a) <domain-error>)
($error (setf (elt '(a b c) -1234567890) 'a) <domain-error>)
($error (setf (elt '(a b c) 1234567890) 'a) <program-error>)
($error (set-elt 'a '(a b c) 3) <program-error>)
($error (set-elt 'a '(a b c) -1) <domain-error>)
($error (set-elt 'a '(a b c) -1234567890) <domain-error>)
($error (set-elt 'a '(a b c) 1234567890) <program-error>)
($test (let ((x (create-list 1000 'a))) (list (setf (elt x 999) 'z) (elt x 999))) (z z) equal)
($test (let ((x (create-list 1000 'a))) (list (set-elt 'z x 999) (elt x 999))) (z z) equal)
;;;
;;; function (SUBSEQ sequence z1 z2) --> sequence
;;;
($ap 2 "subseq" P.99)
($test (subseq "abcdef" 1 4) "bcd" string=)
($test (subseq '(a b c d e f) 1 4) (b c d) equal)
($test (subseq (vector 'a 'b 'c 'd 'e) 1 4) #(b c d) equal)
;;;
($argc subseq 3 0 0)
($type subseq ($string $vector $cons $null) :target 0 1)
($type subseq ($integer) "abc" :target 1)
($type subseq ($integer) #(a b c) :target 1)
($type subseq ($integer) (quote (a b c)) :target 1)
($type subseq ($integer) "abc" 0 :target)
($type subseq ($integer) #(a b c) 0 :target)
($type subseq ($integer) (quote (a b c)) 0 :target)
;;; String
($test (subseq "" 0 0) "" string=)
($error (subseq "" 0 1) <program-error>)
($error (subseq "" 0 -1) <domain-error>)
($error (subseq "" 0 -1234567890) <domain-error>)
($error (subseq "" 0 1234567890) <program-error>)
($error (subseq "" 1 0) <program-error>)
($error (subseq "" -1 0) <domain-error>)
($error (subseq "" -1234567890 0) <domain-error>)
($error (subseq "" 1234567890 0) <program-error>)
($test (subseq "abc" 0 0) "" string=)
($test (subseq "abc" 0 1) "a" string=)
($test (subseq "abc" 0 2) "ab" string=)
($test (subseq "abc" 0 3) "abc" string=)
($error (subseq "abc" 0 4) <program-error>)
($error (subseq "abc" 1 0) <program-error>)
($test (subseq "abc" 1 1) "" string=)
($test (subseq "abc" 1 2) "b" string=)
($test (subseq "abc" 1 3) "bc" string=)
($error (subseq "abc" 1 4) <program-error>)
($error (subseq "abc" 2 0) <program-error>)
($error (subseq "abc" 2 1) <program-error>)
($test (subseq "abc" 2 2) "" string=)
($test (subseq "abc" 2 3) "c" string=)
($error (subseq "abc" 2 4) <program-error>)
($error (subseq "abc" 3 0) <program-error>)
($error (subseq "abc" 3 1) <program-error>)
($error (subseq "abc" 3 2) <program-error>)
($test (subseq "abc" 3 3) "" string=)
($error (subseq "abc" 3 4) <program-error>)
($error (subseq "abc" 0 -1) <domain-error>)
($error (subseq "abc" 0 -1234567890) <domain-error>)
($error (subseq "abc" 0 1234567890) <program-error>)
($error (subseq "abc" -1 0) <domain-error>)
($error (subseq "abc" -1234567890 0) <domain-error>)
($error (subseq "abc" 1234567890 0) <program-error>)
($test (subseq (create-string 1000 #\a) 999 1000) "a" string=)
;;; Vector
($test (subseq #() 0 0) #() equal)
($error (subseq #() 0 1) <program-error>)
($error (subseq #() 0 -1) <domain-error>)
($error (subseq #() 0 -1234567890) <domain-error>)
($error (subseq #() 0 1234567890) <program-error>)
($error (subseq #() 1 0) <program-error>)
($error (subseq #() -1 0) <domain-error>)
($error (subseq #() -1234567890 0) <domain-error>)
($error (subseq #() 1234567890 0) <program-error>)
($test (subseq #(a b c) 0 0) #() equal)
($test (subseq #(a b c) 0 1) #(a) equal)
($test (subseq #(a b c) 0 2) #(a b) equal)
($test (subseq #(a b c) 0 3) #(a b c) equal)
($error (subseq #(a b c) 0 4) <program-error>)
($error (subseq #(a b c) 1 0) <program-error>)
($test (subseq #(a b c) 1 1) #() equal)
($test (subseq #(a b c) 1 2) #(b) equal)
($test (subseq #(a b c) 1 3) #(b c) equal)
($error (subseq #(a b c) 1 4) <program-error>)
($error (subseq #(a b c) 2 0) <program-error>)
($error (subseq #(a b c) 2 1) <program-error>)
($test (subseq #(a b c) 2 2) #() equal)
($test (subseq #(a b c) 2 3) #(c) equal)
($error (subseq #(a b c) 2 4) <program-error>)
($error (subseq #(a b c) 3 0) <program-error>)
($error (subseq #(a b c) 3 1) <program-error>)
($error (subseq #(a b c) 3 2) <program-error>)
($test (subseq #(a b c) 3 3) #() equal)
($error (subseq #(a b c) 3 4) <program-error>)
($error (subseq #(a b c) 0 -1) <domain-error>)
($error (subseq #(a b c) 0 -1234567890) <domain-error>)
($error (subseq #(a b c) 0 1234567890) <program-error>)
($error (subseq #(a b c) -1 0) <domain-error>)
($error (subseq #(a b c) -1234567890 0) <domain-error>)
($error (subseq #(a b c) 1234567890 0) <program-error>)
($test (subseq (create-vector 1000 'a) 999 1000) #(a) equal)
;;; List
($test (subseq () 0 0) () equal)
($error (subseq () 0 1) <program-error>)
($error (subseq () 0 -1) <domain-error>)
($error (subseq () 0 -1234567890) <domain-error>)
($error (subseq () 0 1234567890) <program-error>)
($error (subseq () 1 0) <program-error>)
($error (subseq () -1 0) <domain-error>)
($error (subseq () -1234567890 0) <domain-error>)
($error (subseq () 1234567890 0) <program-error>)
($test (subseq '(a b c) 0 0) () equal)
($test (subseq '(a b c) 0 1) (a) equal)
($test (subseq '(a b c) 0 2) (a b) equal)
($test (subseq '(a b c) 0 3) (a b c) equal)
($error (subseq '(a b c) 0 4) <program-error>)
($error (subseq '(a b c) 1 0) <program-error>)
($test (subseq '(a b c) 1 1) () equal)
($test (subseq '(a b c) 1 2) (b) equal)
($test (subseq '(a b c) 1 3) (b c) equal)
($error (subseq '(a b c) 1 4) <program-error>)
($error (subseq '(a b c) 2 0) <program-error>)
($error (subseq '(a b c) 2 1) <program-error>)
($test (subseq '(a b c) 2 2) () equal)
($test (subseq '(a b c) 2 3) (c) equal)
($error (subseq '(a b c) 2 4) <program-error>)
($error (subseq '(a b c) 3 0) <program-error>)
($error (subseq '(a b c) 3 1) <program-error>)
($error (subseq '(a b c) 3 2) <program-error>)
($test (subseq '(a b c) 3 3) () equal)
($error (subseq '(a b c) 3 4) <program-error>)
($error (subseq '(a b c) 0 -1) <domain-error>)
($error (subseq '(a b c) 0 -1234567890) <domain-error>)
($error (subseq '(a b c) 0 1234567890) <program-error>)
($error (subseq '(a b c) -1 0) <domain-error>)
($error (subseq '(a b c) -1234567890 0) <domain-error>)
($error (subseq '(a b c) 1234567890 0) <program-error>)
($test (subseq (create-list 1000 'a) 999 1000) (a) equal)


;;;
;;; function (MAP-INTO destination function seq*) --> sequence
;;;
($ap 2 "map-into" P.100)
($test (let ((a (list 1 2 3 4))
       (b (list 10 10 10 10)))
   (list (map-into a #'+ a b) a b))
 ((11 12 13 14) (11 12 13 14) (10 10 10 10))
 equal)

($test (let ((a '(11 12 13 14))
       (k '(one two three)))
   (map-into a #'cons k a))
 ((one . 11) (two . 12) (three . 13) 14)
 equal)

($test (let ((x 0)
       (a '((one . 11) (two . 12) (three . 13) 14)))
   (list (map-into a (lambda () (setq x (+ x 2)))) a))
 ((2 4 6 8) (2 4 6 8))
 equal)
 
;;;
($argc map-into 2 0 1)
($type map-into ($string $vector $cons $null) :target (function list))
($type map-into ($function $generic) nil :target)
($type map-into ($string $vector $cons $null) nil (function list) :target)
($type map-into ($string $vector $cons $null) nil (function list) nil :target)
;;; String (0 ����)
($test (let ((a "")) (list (map-into a #'list) a)) ("" "") equal)
($test (let ((a "a")) (list (map-into a (lambda () #\A)) a)) ("A" "A") equal)
($test (let ((a "abc")) (list (map-into a (lambda () #\A)) a)) ("AAA" "AAA") equal)
;;; String (1 ����)
($test (let ((a "") (b "")) (list (map-into a #'list b) a b)) ("" "" "") equal)
($test (let ((a "") (b "abc")) (list (map-into a #'list b) a b)) ("" "" "abc") equal)
($test (let ((a "abc") (b "")) (list (map-into a #'list b) a b)) ("abc" "abc" "") equal)
($test (let ((a "abc") (b "d")) (list (map-into a #'identity b) a b)) ("dbc" "dbc" "d") equal)
($test (let ((a "abc") (b "def")) (list (map-into a #'identity b) a b)) ("def" "def" "def") equal)
($test (let ((a "abc")) (list (map-into a (lambda (x) #\A) a) a)) ("AAA" "AAA") equal)
;;; String (2 ����)
($test (let ((a "") (b "") (c "")) (list (map-into a #'list b c) a b c)) ("" "" "" "") equal)
($test (let ((a "") (b "") (c "abc")) (list (map-into a #'list b c) a b c)) ("" "" "" "abc") equal)
($test (let ((a "abc") (b "") (c "")) (list (map-into a #'list b c) a b c)) ("abc" "abc" "" "") equal)
($test (let ((a "abc") (b "def") (c "ghi")) (list (map-into a (lambda (x y) #\A) b c) a b c))
 ("AAA" "AAA" "def" "ghi")
 equal)
($test (let ((a "abc") (b "d") (c "ghi")) (list (map-into a (lambda (x y) #\A) b c) a b c))
 ("Abc" "Abc" "d" "ghi")
 equal)
;;; Vector (0 ����)
($test (let ((a #())) (list (map-into a #'list) a)) (#() #()) equal)
($test (let ((a #(a))) (list (map-into a (lambda () 'z)) a)) (#(z) #(z)) equal)
($test (let ((a #(a b c))) (list (map-into a (lambda () 'z)) a)) (#(z z z) #(z z z)) equal)
;;; Vector (1 ����)
($test (let ((a #()) (b #())) (list (map-into a #'list b) a b)) (#() #() #()) equal)
($test (let ((a #()) (b #(a b c))) (list (map-into a #'list b) a b)) (#() #() #(a b c)) equal)
($test (let ((a #(a b c)) (b #())) (list (map-into a #'list b) a b)) (#(a b c) #(a b c) #()) equal)
($test (let ((a #(a b c)) (b #(d))) (list (map-into a #'identity b) a b)) (#(d b c) #(d b c) #(d)) equal)
($test (let ((a #(a b c)) (b #(d e f))) (list (map-into a #'identity b) a b))
 (#(d e f) #(d e f) #(d e f))
 equal)
($test (let ((a #(a b c))) (list (map-into a (lambda (x) 'z) a) a)) (#(z z z) #(z z z)) equal)
;;; Vector (2 ����)
($test (let ((a #()) (b #()) (c #())) (list (map-into a #'list b c) a b c))
 (#() #() #() #())
 equal)
($test (let ((a #()) (b #()) (c #(a b c))) (list (map-into a #'list b c) a b c))
 (#() #() #() #(a b c))
 equal)
($test (let ((a #(a b c)) (b #()) (c #())) (list (map-into a #'list b c) a b c))
 (#(a b c) #(a b c) #() #()) equal)
($test (let ((a #(a b c)) (b #(d e f)) (c #(g h i))) (list (map-into a (lambda (x y) 'z) b c) a b c))
 (#(z z z) #(z z z) #(d e f) #(g h i))
 equal)
($test (let ((a #(a b c)) (b #(d)) (c #(g h i))) (list (map-into a (lambda (x y) 'z) b c) a b c))
 (#(z b c) #(z b c) #(d) #(g h i))
 equal)
;;; List (0 ����)
($test (let ((a ())) (list (map-into a #'list) a)) (() ()) equal)
($test (let ((a '(a))) (list (map-into a (lambda () 'z)) a)) ((z) (z)) equal)
($test (let ((a '(a b c))) (list (map-into a (lambda () 'z)) a)) ((z z z) (z z z)) equal)
;;; List (1 ����)
($test (let ((a ()) (b ())) (list (map-into a #'list b) a b)) (() () ()) equal)
($test (let ((a ()) (b '(a b c))) (list (map-into a #'list b) a b)) (() () (a b c)) equal)
($test (let ((a '(a b c)) (b ())) (list (map-into a #'list b) a b)) ((a b c) (a b c) ()) equal)
($test (let ((a '(a b c)) (b '(d))) (list (map-into a #'identity b) a b)) ((d b c) (d b c) (d)) equal)
($test (let ((a '(a b c)) (b '(d e f))) (list (map-into a #'identity b) a b))
 ((d e f) (d e f) (d e f))
 equal)
($test (let ((a '(a b c))) (list (map-into a (lambda (x) 'z) a) a)) ((z z z) (z z z)) equal)
;;; List (2 ����)
($test (let ((a ()) (b ()) (c ())) (list (map-into a #'list b c) a b c))
 (() () () ())
 equal)
($test (let ((a ()) (b ()) (c '(a b c))) (list (map-into a #'list b c) a b c))
 (() () () (a b c))
 equal)
($test (let ((a '(a b c)) (b ()) (c ())) (list (map-into a #'list b c) a b c))
 ((a b c) (a b c) () ()) equal)
($test (let ((a '(a b c)) (b '(d e f)) (c '(g h i))) (list (map-into a (lambda (x y) 'z) b c) a b c))
 ((z z z) (z z z) (d e f) (g h i))
 equal)
($test (let ((a '(a b c)) (b '(d)) (c '(g h i))) (list (map-into a (lambda (x y) 'z) b c) a b c))
 ((z b c) (z b c) (d) (g h i))
 equal)
;;; ����
($test (let ((a "abc") (b #(d e f)) (c '(g h i)) (d #(nil nil nil)))
   (list (map-into d #'list a b c) a b c d))
 (#((#\a d g) (#\b e h) (#\c f i))
  "abc"
  #(d e f)
  (g h i)
  #((#\a d g) (#\b e h) (#\c f i)))
 equal)
($test (let ((a "abc") (b #(d e f)) (c '(g h i)) (d '(nil nil nil)))
   (list (map-into d #'list a b c) a b c d))
 (((#\a d g) (#\b e h) (#\c f i))
  "abc"
  #(d e f)
  (g h i)
  ((#\a d g) (#\b e h) (#\c f i)))
 equal)


