;; Capture by value into a stack environment — spec-memory.md's case 2.
;;
;; An fn is still lifted into a function of its own, but it is no longer handed
;; nothing but its parameters: a local of the enclosing function that it names
;; is *copied* into an environment on that function's frame when the value is
;; made, and the lifted body reads the copy. The value is the code address and
;; that environment beside it, which is why a callee that knows only
;; (Fn [i32] i32) can still call it.
;;
;; What is not here is the escaping half — a value carrying an environment may
;; not outlive the frame the copies are on, and fn-escape*.flan is where each
;; of those refusals is written down.

(defn double [x i32] i32 (* x 2))

(defn apply2 [f (Fn [i32] i32)  x i32] i32 (f x))
(defn call0 [f (Fn [] i32)] i32 (f))
(defn twice [f (Fn [i32] i32)  x i32] i32 (f (f x)))

;; The copy is taken where the value is made and not where it is read, and
;; this is what proves it: the local is changed *after* the fn value exists
;; and before it is called, through a pointer, so nothing about the order can
;; be an accident of evaluation.
(defn bump-then-call [f (Fn [] i32)  p (Ptr i32)] i32
  (set (deref p) 99)
  (f))

(defstruct Pt [x i32  y i32])

(defstruct TooBig [n i32])
(defonce seen i32)

(defn checked [x i32] i32
  (when (> x 100) (signal (TooBig {.n x})))
  x)

;; A handler clause is lifted the same way and captures the same way, and is
;; sound with nothing left over: a handler frame is popped by the body that
;; pushed it, so the establishing frame is alive whenever the clause runs.
;; [budget] is read out of the environment; the accumulator is a global,
;; because a captured copy is a copy and a store into one would leave the
;; local it came from as it was.
(defn handles [] i32
  (let [budget 1000
        xs [5 200 7 300]
        s (slice xs 0 4)
        t 0]
    (handler-bind [(TooBig [c] (set seen (+ seen (+ budget (.n c)))))]
      (dotimes [i 4]
        (set t (+ t (checked (at s i))))))
    (print t) (print " ") (println seen)
    seen))

(defn main [] i32
  ;; The motivating program.
  (let [bonus 10]
    (println (apply2 (fn [x] (+ x bonus)) 5)))

  ;; Copy at creation: the fn answers 1 and the local is 99.
  (let [n 1]
    (print (bump-then-call (fn [] n) (addr n)))
    (print " ")
    (println n))

  ;; What may be captured. A string and a slice are two words copied as two
  ;; words — the bytes stay whoever's they were, which is fine exactly while
  ;; the value cannot outlive the frame that owns them. A struct and a fixed
  ;; array are copied whole. A function value is copied as a function value.
  (let [s "hi"
        arr [1 2 3 4]
        sl (slice arr 0 4)
        p (Pt {.x 3 .y 4})
        g double]
    (println (call0 (fn [] (i32 (length s)))))
    (println (call0 (fn [] (at sl 2))))
    (println (call0 (fn [] (+ (.x p) (.y p)))))
    (println (call0 (fn [] (at arr 3))))
    (println (apply2 (fn [x] (g (+ x 1))) 4)))

  ;; An fn inside an fn, each capturing. The inner one names a local neither
  ;; of them declared, so the outer one captures it too and the inner one
  ;; copies the outer one's copy.
  (let [a 100
        b 20]
    (println (apply2 (fn [x] (+ x (call0 (fn [] (+ a b))))) 3)))

  ;; A loop variable: what the fn sees is the value at the iteration it was
  ;; made on, not the last one. 0 + 1 + 2 + 3.
  (let [total 0]
    (dotimes [i 4]
      (set total (+ total (call0 (fn [] i)))))
    (println total))

  ;; And the same again where the loop variable is rebound by a recur rather
  ;; than stepped by a dotimes, which is a store into the slot the copy is
  ;; taken from: 100 + 101 + 102.
  (println
    (let [base 100]
      (loop [i 0  acc 0]
        (if (< i 3)
          (recur (+ i 1) (+ acc (call0 (fn [] (+ base i)))))
          acc))))

  ;; Called twice, so the environment is read more than once and a body that
  ;; consumed it would show.
  (let [k 5]
    (println (twice (fn [x] (+ x k)) 1)))

  ;; An fn's own let may shadow a name the enclosing function also has, and a
  ;; store into *that* one is an ordinary store: the refusal is about a
  ;; captured copy and not about the spelling. 5 + 1.
  (let [n 5]
    (println (+ n (call0 (fn [] (let [n 0] (set n 1) n))))))

  (println (handles))
  0)