;;; list timing tests

(set! (*s7* 'heap-size) 512000)

(define count 150000)

(define (cxr tries)
  (let* ((iv (make-list 28))
	 (v (list '((1)) '(1 2) '((1 . 2)) '(1 2 . 3) '(((1))) '(1 (2)) '((1 2)) '(((1 . 2))) '(1 2 3)
		  '(1 2 3 . 4) '(1 (2 . 3)) '((1 2 . 3)) '((((1)))) '(1 ((2))) '((1 (2))) '(((1 2))) '(1 2 (3))
		  '(1 2 3 4) '(1 (2 3)) '((1 2 3)) '((((1 . 2)))) '(1 ((2 . 3))) '((1 (2 . 3))) 
		  '(((1 2 . 3))) '(1 2 (3 . 4)) '(1 2 3 4 . 5) '(1 (2 3 . 4)) '((1 2 3 . 4))))
	(tmp (list-tail v 10))
	(tmpiv (list-tail iv 10))
	(tmp1 (list-tail tmp 10))
	(tmpiv1 (list-tail tmpiv 10)))
    (do ((i 0 (+ i 1)))
	((= i tries) iv)
      (set-car! iv (caar (car v)))
      (set-car! (cdr iv) (cadr (cadr v)))
      (set-car! (cddr iv) (cdar (caddr v)))
      (list-set! iv 3 (cddr (cadddr v)))
      (list-set! iv 4 (caaar (list-ref v 4)))
      (list-set! iv 5 (caadr (list-ref v 5)))
      (list-set! iv 6 (cadar (list-ref v 6)))
      (list-set! iv 7 (cdaar (list-ref v 7)))
      (list-set! iv 8 (caddr (list-ref v 8)))
      (list-set! iv 9 (cdddr (list-ref v 9)))
      (set-car! tmpiv (cdadr (car tmp)))
      (set-car! (cdr tmpiv) (cddar (cadr tmp)))
      (set-car! (cddr tmpiv) (caaaar (caddr tmp)))
      (list-set! tmpiv 3 (caaadr (cadddr tmp)))
      (list-set! tmpiv 4 (caadar (list-ref tmp 4)))
      (list-set! tmpiv 5 (cadaar (list-ref tmp 5)))
      (list-set! tmpiv 6 (caaddr (list-ref tmp 6)))
      (list-set! tmpiv 7 (cadddr (list-ref tmp 7)))
      (list-set! tmpiv 8 (cadadr (list-ref tmp 8)))
      (list-set! tmpiv 9 (caddar (list-ref tmp 9)))
      (set-car! tmpiv1 (cdaaar (car tmp1)))
      (set-car! (cdr tmpiv1) (cdaadr (cadr tmp1)))
      (set-car! (cddr tmpiv1) (cdadar (caddr tmp1)))
      (list-set! tmpiv1 3 (cddaar (cadddr tmp1)))
      (list-set! tmpiv1 4 (cdaddr (list-ref tmp1 4)))
      (list-set! tmpiv1 5 (cddddr (list-ref tmp1 5)))
      (list-set! tmpiv1 6 (cddadr (list-ref tmp1 6)))
      (list-set! tmpiv1 7 (cdddar (list-ref tmp1 7))))))

(let ((val (cxr (* count 2))))
  (unless (equal? val '(1 2 2 3 1 2 2 2 3 4 3 3 1 2 2 2 3 4 3 3 2 3 3 3 4 5 4 4))
    (format *stderr* "cxr: ~S~%?" val)))

(define (cxr-implicit tries)
  (let* ((iv (list 1 2 2 3 1 2 2 2 3 4 3 3 1 2 2 2 3 4 3 3 2 3 3 3 4 5 4 4))
	 (v (list '((1)) '(1 2) '((1 . 2)) '(1 2 . 3) '(((1))) '(1 (2)) '((1 2)) '(((1 . 2))) '(1 2 3)
                   '(1 2 3 . 4) '(1 (2 . 3)) '((1 2 . 3)) '((((1)))) '(1 ((2))) '((1 (2))) '(((1 2))) '(1 2 (3))
                   '(1 2 3 4) '(1 (2 3)) '((1 2 3)) '((((1 . 2)))) '(1 ((2 . 3))) '((1 (2 . 3))) 
                   '(((1 2 . 3))) '(1 2 (3 . 4)) '(1 2 3 4 . 5) '(1 (2 3 . 4)) '((1 2 3 . 4))))
	 (tmp (list-tail v 10))
	 (L1 (cadr v))
	 (L4 (list-ref v 4))
	 (L5 (list-ref v 5))
	 (L6 (list-ref v 6))
	 (L8 (list-ref v 8))
	 (L12 (caddr tmp))
	 (L13 (cadddr tmp))
	 (L14 (list-ref tmp 4))
	 (L15 (list-ref tmp 5))
	 (L16 (list-ref tmp 6))
	 (L17 (list-ref tmp 7))
	 (L18 (list-ref tmp 8))
	 (L19 (list-ref tmp 9)))
    (do ((i 0 (+ i 1)))
	((= i tries) iv)
      (set-car! iv ((car v) 0 0))
      (set-car! (cdr iv) (L1 1))
      (list-set! iv 4 (L4 0 0 0))
      (list-set! iv 5 (L5 1 0))
      (list-set! iv 6 (L6 0 1))
      (list-set! iv 8 (L8 2))
      (list-set! iv 12 (L12 0 0 0 0))
      (list-set! iv 13 (L13 1 0 0))
      (list-set! iv 14 (L14 0 1 0))
      (list-set! iv 15 (L15 0 0 1))
      (list-set! iv 16 (L16 2 0))
      (list-set! iv 17 (L17 3))
      (list-set! iv 18 (L18 1 1))
      (list-set! iv 19 (L19 0 2)))))

(let ((val (cxr-implicit (/ count 4))))
  (unless (equal? val (list 1 2 2 3 1 2 2 2 3 4 3 3 1 2 2 2 3 4 3 3 2 3 3 3 4 5 4 4))
    (format *stderr* "cxr: ~S~%?" val)))


(define (obj->list tries)
  (let ((str "asdffdsa")
	(v #(0 1 2 3 4 5 6 7 8 9))
	(r (random-state 12344321))
	(rl ()))
    (do ((i 0 (+ i 1)))
	((= i tries))
      (set! str (list->string (string->list str)))
      (set! v (list->vector (vector->list v)))
      (set! r (apply random-state (random-state->list r))))
    (unless (equal? str "asdffdsa")
      (format *stderr* "str: ~S~%" str))
    (unless (equal? v #(0 1 2 3 4 5 6 7 8 9))
      (format *stderr* "v: ~S~%" v))
    (unless (equal? r (random-state 12344321))
      (format *stderr* "r: ~S~%" r))))

(unless (or (provided? 'gmp) (provided? 'pure-s7))
  (obj->list count))


(define (lst tries)
  (let ((L (make-list 10))
	(L1 (cons 0 0)))
    (do ((i 0 (+ i 1)))
	((= i tries))
      (do ((k 0 (+ k 1))
	   (val L (cdr val)))
	  ((= k 10))
	(list-set! L k (* k 2))
	(unless (= (list-ref L k) (* k 2))
	  (format *stderr* "Lref: ~S ~S~%" (list-ref L k) (* k 2)))
	(unless (equal? (list-tail L k) val)
	  (format *stderr* "Ltail: ~S ~S ~S~%" (list-tail L k) val k))
	(set-car! L1 (car val))
	(set-cdr! L1 (proper-list? L))
	(unless (equal? (list 0 0 0) (make-list 3 0))
	  (format *stderr* "list/make-list trouble: ~S ~S\n" (list 0 0 0) (make-list 3 0)))))))

(lst count)


(define (trees tries)
  (let ((lists (list (list 1 2 3)
		     (cons 1 2)
		     (list 1)
		     (list)
		     (list (list 1 2) (list 3 4))
		     (list (list 1 2) 3)
		     '(1 . 2)
		     '(a b c)
		     '((a) b (c))
		     '((1 2) (3 4))
		     '((1 2 3) (4 5 6) (7 8 9))
		     '(((1) (2) (3)) ((4) (5) (6)) ((7) (8) (9)))
		     '((((1 123) (2 124) (3 125) (4 126)) ((5) (6) (7) (8)) ((9) (10) (11) (12)) ((13) (14) (15) (16)))
		       (((21 127) (22 128) (23 129) (24 130)) ((25) (26) (27) (28)) ((29) (30) (31) (32)) ((33) (34) (35) (36)))
		       (((41 131) (42 132) (43 133) (44 134)) ((45) (46) (47) (48)) ((49) (50) (51) (52)) ((53) (54) (55) (56)))
		       (((61 135) (62 136) (63 137) (64 138)) ((65) (66) (67) (68)) ((69) (70) (71) (72)) ((73) (74) (75) (76)))
		       321)))
	(v (make-list 6)))
    (do ((i 0 (+ i 1)))
	((= i tries))
      (set-car! v (tree-leaves lists))
      (list-set! v 1 (tree-memq 'c lists))
      (list-set! v 2 (tree-count 1 lists))
      (list-set! v 3 (tree-cyclic? lists))
      (list-set! v 4 (tree-set-memq '(d b e) lists))
      (list-set! v 5 (length lists)))
    (unless (equal? v '(125 #t 10 #f #t 13))
      (format *stderr* "trees: ~S~%" v))))
    
(trees (/ count 10))


(define (look tries)
  (let ((alist '((a . 0) (b . 1) (c . 2) (d . 3)))
	(mlist '(a b c d))
	(v (make-list 6))
	(L '(0 1 2 3 4))
	(L1 ()))
    (do ((i 0 (+ i 1)))
	((= i tries))
      (set! L1 (reverse L))
      (set! L1 (reverse! L1))
      (set! L1 (sort! L >))
      (set! L1 (fill! L 0)) ; fill! returns the fill value -> 0
      (set! L1 (copy L))
      (set-car! v (assq 'd alist))
      (list-set! v 1 (assv 'd alist))
      (list-set! v 2 (assoc 'd alist))
      (list-set! v 3 (memq 'd mlist))
      (list-set! v 4 (memv 'd mlist))
      (list-set! v 5 (member 'd mlist)))
    (unless (equal? v '((d . 3) (d . 3) (d . 3) (d) (d) (d)))
      (format *stderr* "look: ~S~%" v))))

(look count)


(define c?r
  (let ((body ()))
    (define (X-marks-the-spot accessor tree)
      (if (eq? tree 'X)
	  accessor
	  (and (pair? tree)
	       (or (X-marks-the-spot (cons 'car accessor) (car tree))
		   (X-marks-the-spot (cons 'cdr accessor) (cdr tree))))))
    (define (extend-path f)
      (set! body (list f body)))
    (lambda (path)
      (set! body 'lst)
      (for-each extend-path (reverse (X-marks-the-spot () path))) ; reverse! saves 30
      body)))

(define (find-X tries)
  (let ((val ()))
    (do ((i 0 (+ i 1)))
	((= i tries))
      (set! val (c?r '(0 (1 (2 (3 (4 (5 (6 (7 (X))))))))))))
    (unless (equal? val '(car (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr lst))))))))))))))))))
      (format *stderr* "find-X: ~S~%" val))))

(find-X count)


(define (cons-r a b n) 
  (if (= n 0)
      (cons a b)
      (cons (cons-r (+ a 1) (+ b 1) (- n 1))
	    (cons-r (- a 1) (- b 1) (- n 1)))))

(define (cons-test tries)
  (do ((i 0 (+ i 1)))
      ((= i tries))
    (cons-r 0 0 6)))

(cons-test (/ count 10))


(define (list-r a b n) 
  (if (= n 0)
      (list a b) 
      (cons (list-r (+ a 1) (+ b 1) (- n 1)) 
	    (list-r (- a 1) (- b 1) (- n 1)))))

(define (list-test tries)
  (do ((i 0 (+ i 1)))
      ((= i tries))
    (list-r 0 0 6)))

(list-test (/ count 10))


(exit)