(set! (*s7* 'heap-size) (* 3 1024000))

(define size 100000)

(define (memb x ls)
  (call-with-exit
   (lambda (break)
     (do ((ls ls (cdr ls)))
	 ((null? ls) #f)
       (if (eq? x (car ls))
	   (break ls))))))

(define (membtest)
  (do ((i 0 (+ i 1)))
      ((= i size))
    (memb 'd '(a b c))
    (memb 'b '(a b c))))

(membtest) ; 174, eval 71, op_dox 32, fx_c_s_car_s 19, resize_heap_to 12, call_with_exit 8


(define (find-if f sequence)
  (call-with-exit
   (lambda (return)
     (for-each (lambda (arg)
		 (if (f arg)
		     (return arg)))
	       sequence)
     #f)))

(define (find-if-test)
  (let ((lst '((#f 1) (#f 2) (3 3) (#f 4))))
    (do ((i 0 (+ i 1)))
	((= i size))
      (find-if car lst))))

(find-if-test)


(define-expansion (while test . body)      ; while loop with predefined break and continue.
  `(call-with-exit
    (lambda (break)
      (let loop ()
	(call-with-exit
	 (lambda (continue)
	   (do ()
	       ((not ,test) (break))
	     ,@body)))
	(loop)))))

(define (while-test)
  (do ((i 0)
       (k 0 (+ k 1)))
      ((= k size))
    (while (< i 100)
      (when (= i 3) (set! i 0) (break))
      (set! i (+ i 1))
      (if (> i 3) (display "oops:while\n")))))

(while-test)


(define (dwfib n)
  (dynamic-wind
      (lambda () 
	(if (negative? n) (display "oops")))
      (lambda ()
	(if (<= n 2)
	    n
	    (+ (dwfib (- n 1))
               (dwfib (- n 2)))))
      #f))

(dwfib 28)

(define (fcall)
  (call/cc
   (lambda (return)
     (do ((i 0 (+ i 1)))
	 ((= i 10))
       (if (= i 3)
	   (return 32)))))) ; check call/cc -> call-with-exit opt

(define (test-fcall)
  (do ((k 0 (+ k 1)))
      ((= k size))
    (fcall)))
(test-fcall)


(define lsize 100000)

(define (f x a) (x a))

(define (g1 lsize)
  (do ((i 0 (+ i 1)))
      ((= i lsize))
    (f (lambda (b) (+ b 1)) 10)))  ; ((lambda (b) (+ b 1)) 10)

(define (g2 lsize)
  (let loop ((i lsize))
    (when (>= i 0)
      (f (lambda (b) (+ b 1)) 10) ; ((lambda (b) (+ b 1)) 10)
      (loop (- i 1)))))

(define (g3 lsize)
  (do ((i 0 (+ i 1)))
      ((= i lsize))
    (f (vector 11) 0))) ; ((vector 11) 0)

(g1 lsize)
(g2 lsize)
(g3 lsize)


(define (g31 g30 lsize)
  (do ((i 0 (+ i 1)))
      ((= i lsize))
    (g30 i)))

(g31 (lambda (x) (+ x 2)) lsize) ; fastest (more than 2x)


(define (f2 a x) (x a)) ; op_closure_af?

(define (g32 lsize)
  (do ((i 0 (+ i 1)))
      ((= i lsize))
    (f2 10 (lambda (b) (+ b 1)))))

(g32 lsize)


(define (f1 x1 x2 a) ; eval_args [unk(unk a) OP_S_opSq?]
  (x2 (x1 a)))

(define (f11 x1 x2 a) ; no eval_args [eval->op_safe_c_pp]
  (+ (x2 a) (x1 a)))

(display (f1 (lambda (b) (+ b 1)) (lambda (c) (* c 2)) 10)) (newline)

(define (g4 lsize)
  (do ((i 0 (+ i 1)))
      ((= i lsize))
    (f1 (lambda (b) (+ b 1)) (lambda (c) (* c 2)) 10)))

(define (g5 lsize)
  (let loop ((i lsize))
    (when (>= i 0)
      (f1 (lambda (b) (+ b 1)) (lambda (c) (* c 2)) 10)
      (loop (- i 1)))))

(define (g6 lsize)
  (let loop ((i lsize))
    (when (>= i 0)
      (f1 (lambda* (b (d 1)) (+ b d)) (macro (c) `(* ,c 2)) 10)
      (loop (- i 1)))))

(display (f1 (lambda* (b (d 1)) (+ b d)) (macro (c) `(* ,c 2)) 10)) (newline)
(display (f1 (lambda* (b (d 1)) (+ b d)) (lambda (c) (* c 2)) 10)) (newline)

(g4 lsize) ; (2x slower than g1)
(g5 lsize) 
(g6 lsize)  ; very slow, eval args (2x slower than g5)


(define (tc-1 x y) 
  (if (pair? x)
      (tc-1 (cdr x) y) 
      (begin (vector-set! y 0 32) y)))

(define (g7)
  (equal? (tc-1 '(1 2 3) #(1 2 3)) #(32 2 3)))

(display (g7)) (newline)

(define (g71)
  (do ((i 0 (+ i 1)))
      ((= i lsize))
    (g7)))

(g71)

(define (g80)
  (do ((i 0 (+ i 1)))
      ((= i lsize))
    ((lambda () (+ i 1)))))

(g80)

(define (g81)
  (do ((i 0 (+ i 1)))
      ((= i lsize))
    ((lambda (x) (+ x 1)) i)))

(g81)

(define (g82)
  (do ((i 0 (+ i 1)))
      ((= i lsize))
    ((lambda (x y) (+ x y)) i (+ i 1))))

(g82)


(define (g9)
  (do ((i 0 (+ i 1)))
      ((= i lsize))
    (g10 + (lambda (x y) (* x y)))))

(define (g10 f1 f2)
  (- (f1 1 2) (f2 3 4)))

(display (g10 + (lambda (x y) (* x y)))) (newline)

(g9)


(exit)
