;;;; Arithmetic with no answer is a condition, not a SIGFPE.
;;;;
;;;; Three situations had no defined behaviour in this language until now, and
;;;; the two backends disagreed on all three. A divide or remainder by zero was
;;;; a raw SIGFPE: the process died with no message, no location, and nothing
;;;; to handle — which is the worst failure in the whole system, because it
;;;; tells the programmer less than a segfault does. (/ min -1) is the one
;;;; division whose true quotient is one past the top of the type, and `idiv`
;;;; makes that a SIGFPE too where LLVM calls it undefined. And a float to
;;;; integer cast whose value does not fit produces x86's fixed "integer
;;;; indefinite" under one backend and whatever the optimiser feels like under
;;;; the other.
;;;;
;;;; All three now signal ArithError with `error`, the same way a bad index
;;;; signals BoundsError. This program is the "something answered" half; the
;;;; unhandled half is arith.flan, which dies with a sentence naming the file,
;;;; the line and the operands.
;;;;
;;;; The decision worth reading this file for is the same one BoundsError
;;;; made, and here it was forced rather than chosen. **No restart is
;;;; established at the failing operation.** A restart frame is allocated by
;;;; the restart-case that offers it, on its own stack, and a transfer carries
;;;; that frame's address — so nothing in the runtime can push one on a
;;;; program's behalf, and a `use-value` at the failing division would mean an
;;;; alloca and a restart frame emitted at every division in every checked
;;;; build. That is the cost already refused for indexing, buying a silently
;;;; different answer, and division is the weaker case of the two: an `at` at
;;;; least has an element to hand back. What answers a division by zero here is
;;;; the restart the program already had — a frame loop's `continue`, which is
;;;; sand.flan's shape and is what a game wants: abandon this frame, keep the
;;;; window open.
;;;;
;;;; Four things are asserted:
;;;;
;;;;   1. The frame is abandoned and the program carries on, over every one of
;;;;      the five codes.
;;;;   2. Defers run. An answered arithmetic failure leaves through the same
;;;;      unwind path a `return` uses, so the defers run innermost first; a
;;;;      SIGFPE ran none, and could not have.
;;;;   3. The condition carries the numbers: `op` says which of the five, and
;;;;      `lhs`/`rhs` are the two operands for a division and the destination
;;;;      type's representable range for a cast.
;;;;   4. Division that is fine stays fine, including the two shapes the guard
;;;;      is allowed to elide — a literal divisor that is neither 0 nor -1, and
;;;;      unsigned division, which has no overflow case at all.

(defvar frames  i64)
(defvar skipped i64)
(defvar cleaned i64)
(defvar op      i32)
(defvar lhs     i64)
(defvar rhs     i64)

;;; Globals rather than locals because a handler cannot see the locals of the
;;; function that established it — check.ml refuses a capture by name and says
;;; to use a global.
(defvar zero  i64)
(defvar neg1  i64 -1)
(defvar big   i64 9223372036854775807)
(defvar huge  f64 1e300)
(defvar small f64 -1e300)
(defvar uz    u32)

(defn show [name string  n i64] ()
  (print name) (print " ") (print n) (println ""))

;;; Two frames deep with a defer on the way, so the transfer has something to
;;; cross and something to run on its way out.
(defn divide [a i64  b i64] i64
  (defer (set cleaned (+ cleaned 1)))
  (/ a b))

(defn remainder [a i64  b i64] i64
  (defer (set cleaned (+ cleaned 1)))
  (% a b))

(defn narrow [x f64] i64
  (defer (set cleaned (+ cleaned 1)))
  (i64 x))

(defn narrow-8 [x f64] i8
  (defer (set cleaned (+ cleaned 1)))
  (i8 x))

;;; The frame loop's shape: one restart-case around the work, offering
;;; `continue`, which abandons this frame and nothing else.
(defn div-frame [a i64  b i64] ()
  (restart-case
    (do (show "div" (divide a b))
        (set frames (+ frames 1)))
    (continue [] (set skipped (+ skipped 1)))))

(defn rem-frame [a i64  b i64] ()
  (restart-case
    (do (show "rem" (remainder a b))
        (set frames (+ frames 1)))
    (continue [] (set skipped (+ skipped 1)))))

(defn cast-frame [x f64] ()
  (restart-case
    (do (show "cast" (narrow x))
        (set frames (+ frames 1)))
    (continue [] (set skipped (+ skipped 1)))))

(defn cast8-frame [x f64] ()
  (restart-case
    (do (show "cast8" (i64 (narrow-8 x)))
        (set frames (+ frames 1)))
    (continue [] (set skipped (+ skipped 1)))))

(defn main [] i32
  ;; The most negative i64, which no literal in this language can spell: the
  ;; reader parses the digits and then negates, and the positive half of the
  ;; pair does not fit.
  (let [min (- (- (i64 0) big) 1)]

    (handler-bind
      [(ArithError [c]
         ;; The numbers rather than a message, for the reason StorageExhausted
         ;; has none: formatting allocates, and a condition has to be buildable
         ;; on a frame where allocation may be the thing that failed.
         (set op  (.op c))
         (set lhs (.lhs c))
         (set rhs (.rhs c))
         ;; Abandon the frame. The transfer crosses `divide` — running its
         ;; defer — and lands in the clause of the restart-case two frames out.
         (invoke-restart 'continue))]

      ;; Fine, so the handler never runs and the defer runs on the ordinary
      ;; return path.
      (div-frame 10 3)

      ;; Code 0: a divide by zero. `lhs` and `rhs` are the operands as written.
      (div-frame 10 zero)
      (show "op" (i64 op))
      (show "lhs" lhs)
      (show "rhs" rhs)

      ;; Code 1: the same for a remainder, which is a different instruction and
      ;; its own arm in both backends.
      (rem-frame 7 zero)
      (show "op" (i64 op))

      ;; Code 2: the one division that overflows. Nothing about the divisor is
      ;; wrong and nothing about the dividend is wrong; it is the pair.
      (div-frame min neg1)
      (show "op" (i64 op))
      (show "lhs" lhs)
      (show "rhs" rhs)

      ;; Code 3: and its remainder, which overflows on exactly the same pair —
      ;; the intermediate quotient is the thing that does not fit, and `srem`
      ;; computes one too.
      (rem-frame min neg1)
      (show "op" (i64 op))

      ;; In range, so no signal: the truncation toward zero is the ordinary
      ;; result and the guard is not in the way of it.
      (cast-frame 3.9)
      (cast-frame -3.9)

      ;; Code 4, both ends. `lhs` and `rhs` are the destination's range rather
      ;; than the value, because the value is a float and these fields are not;
      ;; what a handler needs in order to say anything useful is the range it
      ;; missed.
      (cast-frame huge)
      (show "op" (i64 op))
      (show "lhs" lhs)
      (show "rhs" rhs)
      (cast-frame small)
      (show "op" (i64 op))

      ;; A narrower destination reports its own range, which is the whole point
      ;; of carrying one: 300 is a perfectly ordinary number and is out of
      ;; range only for this type.
      (cast8-frame 12.0)
      (cast8-frame 300.0)
      (show "lhs" lhs)
      (show "rhs" rhs)

      ;; NaN fails both halves of the range test, which is deliberate: a NaN
      ;; cast to an integer is exactly as undefined as a value out of range,
      ;; and an unordered comparison would have waved it through.
      (cast-frame (/ (f64 0.0) (f64 0.0)))
      (show "op" (i64 op))

      ;; And the shapes the guard is allowed to drop, which have to keep
      ;; working. A literal divisor that is neither 0 nor -1 needs no test at
      ;; all; unsigned division needs the zero test and has no overflow case,
      ;; because there is no most-negative value to overflow from.
      (show "lit" (/ (+ big 0) 2))
      (show "u" (i64 (/ (u32 100) (+ uz 7))))))

  ;; Four frames finished, eight were abandoned, and all twelve ran their
  ;; defer — the claim a SIGFPE could not make.
  (show "frames" frames)
  (show "skipped" skipped)
  (show "cleaned" cleaned)
  0)