;;; tlamb.scm
;;;   using define_constant a lt here to get past closure_is_ok et al, this part of s7 is a mess

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

(define size 1000000)

;;; -------- [416] --------
(define-constant (f1 x) (x 123))   ; op_closure_a for (x 123)

;(display (f1 (lambda (y) (+ y 1)))) (newline)

(define (f1-test)
  (do ((i 0 (+ i 1)))
      ((= i size))
    (f1 (lambda (y) (+ y 1)))))   ; op_lambda_unchecked -> make_closure_unchecked, op_simple_do_step -> op_closure_p

(f1-test)


;;; -------- [467] --------
(define-constant (f2 x)           ; 465 if define-constant, 675 if both are define-constant
  (define (f2_1 y) (+ y 1))       ; define_funchecked + make_funclet, op_safe_closure_s -- don't declare this define-constant
  (f2_1 x))

;(display (f2 123)) (newline)

(define (f2-test)
  (do ((i 0 (+ i 1)))
      ((= i size))
    (f2 123)))                    ; op_closure_a from op_safe_dotimes_step_o

(f2-test)


;;; -------- [110] --------
(define-constant f3 (let ()                
		      (define-constant (f3_1 y) (+ y 1))
		      (lambda (x)
			(f3_1 x))))        ; fx_safe_closure_s_to_add1 [s_to_sc]

;(display (f3 123)) (newline)

(define (f3-test)
  (do ((i 0 (+ i 1)))
      ((= i size))
    (f3 123)))                   ; op_safe_closure_a_o from op_safe_dotimes_step_o

(f3-test)

;;; f1 could be faster, treat (lambda...) as a one-time evaluation (but where to save == lamlet? it's a do-loop: save locally)


;;; -------- [82] --------
(define-constant (f4_1 y) (+ y 1)) ; fx_safe_closure_s_to_add1
(define-constant (f4 x) (f4_1 x)) ; faster than f3 because of the define-constant (allows opt cases), 110 if define
                                  ;   has_fx f4, whereas not has_fx f3
;(display (f4 123)) (newline)

(define (f4-test)
  (do ((i 0 (+ i 1)))            ; opt_dotimes opt_p_fx_any
      ((= i size))
    (f4 123)))                   ; fx_safe_closure_a_a -> safe_closure_add1_c [y=c etc] -> add1_c or inner body using s->val

(f4-test)


;;; -------- [237] --------
(define-constant (f5 x) ((lambda (y) (+ y 1)) x))

;(display (f5 123)) (newline)

(define (f5-test)
  (do ((i 0 (+ i 1)))            ; op_safe_dotimes_step_o -> op_f_a [op_safe_sc] -- this could be optimized [op_f_fx_a?], caddar(sc->code) is fxable
      ((= i size))
    (f5 123)))                   ; op_closure_a_o

(f5-test)


;;; -------- [216] --------
(define-constant f6 (let ((f6_1 (lambda (y) (+ y 1)))) ; use letrec (f7) or define (f3) 2x faster??
		      (lambda (x)
			(f6_1 x))))       ; op_closure_s_o

;(display (f6 123)) (newline)

(define (f6-test)
  (do ((i 0 (+ i 1)))
      ((= i size))
    (f6 123)))                   ; op_closure_a_o

(f6-test)


;;; -------- [110] --------
(define-constant f7 (letrec ((f7_1 (immutable! (lambda (y) (+ y 1))))) ; 110?!? letrec* same,  fx_safe_closure_s_to_add1
		      (lambda (x)
			(f7_1 x))))       ; op_safe_closure_a_o via letrec_setup_closures

;(display (f7 123)) (newline)

(define (f7-test)
  (do ((i 0 (+ i 1)))            ; op_safe_dotimes_step_o
      ((= i size))
    (f7 123)))

(f7-test)


;;; -------- [61] --------
(define-constant (f8 x) (+ x 1)) ; the obvious case... 97 if define rather than define-constant

;(display (f8 123)) (newline)

(define (f8-test)
  (do ((i 0 (+ i 1)))            ; opt_dotimes opt_p_fx_any
      ((= i size))
    (f8 123)))                   ; fx_safe_closure_a_to_sc

(f8-test)


;;; -------- [375] --------
(define-constant (f9 x)
  (let ((f9_1 (lambda (y) (+ y 1)))) ; faster than define (f2)??  make_closure_unchecked
    (f9_1 x)))

;(display (f9 123)) (newline)

(define (f9-test)
  (do ((i 0 (+ i 1)))
      ((= i size))
    (f9 123)))

(f9-test)


;;; -------- [140] --------
(define-constant (f10 x) (f10_1 x))  ; call before definition, 134 if define-constant
(define-constant (f10_1 y) (+ y 1))  ; fx_safe_closure_s_to_add1
                           
;(display (f10 123)) (newline)

(define (f10-test)
  (do ((i 0 (+ i 1))) 
      ((= i size))
    (f10 123)))             ; op_closure_a_o [safe_closure_a_o if in the correct order, f3]

(f10-test)


;;; -------- [614] --------
(define-macro (f11_1 y) `(+ ,y 1)) ; 97 if expansion
(define-constant (f11 x) (f11_1 x))
                           
;(display (f11 123)) (newline)

(define (f11-test)
  (do ((i 0 (+ i 1))) 
      ((= i size))
    (f11 123)))

(f11-test)


;;; -------- [43] --------
(define-macro (f12_1 y) `(+ ,y 1))
(define-macro (f12 x) `(f12_1 ,x))
                           
;(display (f12 123)) (newline)

(define (f12-test)
  (do ((i 0 (+ i 1))) 
      ((= i size))
    (f12 123)))

(f12-test)


;;; -------- [18] --------
(define-expansion (f13_1 y) `(+ ,y 1))
(define-expansion (f13 x) `(f13_1 ,x))   ; perhaps f4 expanded to fx of body?
                           
;(display (f13 123)) (newline)

(define (f13-test)
  (do ((i 0 (+ i 1))) 
      ((= i size))
    (f13 123)))         ; opt_dotimes opt_i_ii_cc add_i_ii, no eval

(f13-test)


;;; -------- [174] --------
(define* (f14_1 (y 0)) (+ y 1))
(define-constant f14 (lambda* ((x 0)) (f14_1 x)))
                           
;(display (f14 123)) (newline)

(define (f14-test)      ; why 2x slower than f4, f4 (define case) uses fx_safe_closure_s_to_add1 = less eval + g_add_x1 + fx_t
  (do ((i 0 (+ i 1))) 
      ((= i size))
    (f14 123)))         ; op_safe_closure_star_a1

(f14-test)


;;; -------- [209] --------
(define-constant f15 (letrec ((f15_1 (immutable! (lambda (y) (+ y 1))))
			      (f15_2 (immutable! (lambda (y) (* y 2)))))
		       (lambda (x)
			 (f15_2 (f15_1 x)))))

;(display (f15 61)) (newline)

(define (f15-test)
  (do ((i 0 (+ i 1)))
      ((= i size))
    (f15 61)))

(f15-test)


;;; -------- [715] --------
(define-constant (f16 f_1 f_2) (f_2 (f_1 61))) ; f_2 here hop=1

;(display (f16 (lambda (y) (+ y 1)) (lambda (y) (* y 2)))) (newline)

(define (f16-test)
  (do ((i 0 (+ i 1)))
      ((= i size))
    (f16 (lambda (y) (+ y 1))
	 (lambda (y) (* y 2)))))

(f16-test)


;;; -------- [342] --------
(define-constant (f16_1 y) (+ y 1))
(define-constant (f16_2 y) (* y 2))

;(display (f16 f16_1 f16_2)) (newline)

(define (f17-test)
  (do ((i 0 (+ i 1)))
      ((= i size))
    (f16 f16_1 f16_2)))

(f17-test)


;;; -------- [313] --------
(define-constant (f18 . args)           ; [346] -> 318 (safe_thunk) but tmisc up 10 6341 if op_safe_thunk_any -> 313 (fx_is_null_t)
  (if (null? args) 1 0))       ; fx_is_null_t if safe_thunk_any

(define (dof18)
  (do ((sum 0)                 ; op_dox_step_o
       (i 0 (+ i 1)))          ; fx_add_t1
      ((= i size) sum)         ; fx_num_eq_ti
    (set! sum (+ sum (f18))))) ; op_safe_c_sp + op_safe_thunk_any

(unless (= (dof18) size) (format *stderr* "dof18: ~S~%" (dof18)))
	    

;;; -------- [449] --------
(define-constant (f19 . args)     ; [449] => 310 if (define (g arg)...)
  (+ (car args) 1))      ; eval:fx_c_opsq_c_any -> car add_x1 (eval)

(define (dof19)
  (do ((sum 0)           ; op_dox_step_o
       (i 0 (+ i 1)))    ; fx_add_t1 -> g_add_x1
      ((= i size) sum)   ; fx_num_eq_ti
    (set! sum (+ sum (f19 i))))) ; op_any_closure_sym via set_symbol_p+safe_set

(unless (= (dof19) (/ (* size (+ size 1)) 2)) (format *stderr* "dof19: ~S~%" (dof19)))


;;; -------- [520] --------
(define-constant (f20 a . b)
  (+ a (car b)))         ; fx_c_s_opsq -> g_add_2 + g_car

(define (dof20) ;[618 -> 609 -> 520] op_any_closure_a_sym
  (do ((sum 0)           ; op_dox_step_o
       (i 0 (+ i 1)))    ; fx_add_t1
      ((= i size) sum)   ; fx_num_eq_ti
    (set! sum (+ sum (f20 i 1)))))

(unless (= (dof20) (/ (* size (+ size 1)) 2)) (format *stderr* "dof20: ~S~%" (dof20)))


;;; --------------------------------
(define-constant (f31 x)
  (define (f32 y) (+ y 1))
  (- (f32 x) 1))

(define-constant (g31)
  (let loop ((z size))
    (if (positive? (f31 z))
	(loop (- z 1)))))

(g31) ; 760


(define-constant (f33 x)
  (let ((f34 (lambda (y) (+ y 1))))
    (- (f34 x) 1)))

(define-constant (g32)
  (let loop ((z size))
    (if (positive? (f33 z))
	(loop (- z 1)))))

(g32) ; 667


(define-constant (f36 y) (+ y 1))
(define-constant (f35 x) (- (f36 x) 1))

(define-constant (g33)
  (let loop ((z size))
    (if (positive? (f35 z))
	(loop (- z 1)))))

(g33) ; 255 -> 242 g_sub_xi -> 225 fx_sub_a1


(define-constant (f38 y) (+ y 1))
(define-constant (f37 x) (- (f38 x) 1))

(define-constant (g34)
  (let loop ((z size))
    (if (positive? (f37 z))
	(loop (- z 1)))))

(g34) ; 348


(define-constant (f310 y) (- y 1))
(define-constant (f39 x) (+ (f310 x) 1))

(define-constant (g35)
  (let loop ((z (- size)))
    (if (negative? (f39 z))
	(loop (+ z 1)))))

(g35) ; 229 [fx_add_a1]



(exit)