;;;; The slice family at its second and third element types.
;;;;
;;;; sort-i32! was the only sort in the language. These are the other two, and
;;;; they are copies rather than an abstraction: map, filter, reduce and a sort
;;;; taking a comparator all need a *function value*, which check.ml refuses
;;;; with "a function type is not implemented yet -- milestone 5". So the
;;;; honest form is the concrete one, and the claim this file makes is only
;;;; that the concrete ones are right.

(defn show-f32 [s [f32]] ()
  (dotimes [i (len s)]
    (print (at s i))
    (print " "))
  (println ""))

(defn show-fields [s [[u8]]] ()
  (dotimes [i (len s)]
    (print (string (at s i)))
    (print " "))
  (println ""))

(defn main [] i32
  ;; Every float literal is cast. A literal defaults to f64 and an array
  ;; literal has no context to say otherwise -- a let has no type annotation --
  ;; so [3.5 -1.0] is an [f64] and (sort-f32!) refuses it by type. The cast is
  ;; the only spelling available today.
  ;;
  ;; sort-f32!: duplicates, negatives, a zero and an odd length, which is the
  ;; input shape the i32 sort is tested on for the same reasons.
  (let [xs [(f32 3.5) (f32 -1.0) (f32 0.0) (f32 3.5) (f32 -2.25) (f32 10.0) (f32 0.5)]]
    (sort-f32! (slice xs 0 7))
    (show-f32 (slice xs 0 7)))          ; -2.25 -1 0 0.5 3.5 3.5 10

  ;; In place and ptr+len: sorting a subslice leaves its neighbours alone. That
  ;; is the whole content of the in-place claim, and a version that copied
  ;; would pass every test above and fail this one.
  (let [xs [(f32 9.0) (f32 4.0) (f32 3.0) (f32 2.0) (f32 1.0) (f32 9.0)]]
    (sort-f32! (slice xs 1 5))
    (show-f32 (slice xs 0 6)))          ; 9 1 2 3 4 9

  ;; Already sorted, reverse sorted, and a single element -- the three inputs
  ;; where an insertion loop with the comparison the wrong way round still
  ;; looks plausible.
  (let [xs [(f32 1.0) (f32 2.0) (f32 3.0)]]
    (sort-f32! (slice xs 0 3))
    (show-f32 (slice xs 0 3)))          ; 1 2 3
  (let [xs [(f32 3.0) (f32 2.0) (f32 1.0)]]
    (sort-f32! (slice xs 0 3))
    (show-f32 (slice xs 0 3)))          ; 1 2 3
  (let [xs [(f32 7.0)]]
    (sort-f32! (slice xs 0 1))
    (show-f32 (slice xs 0 1)))          ; 7
  ;; The empty slice must not read (at s -1).
  (let [xs [(f32 7.0)]]
    (sort-f32! (slice xs 0 0))
    (show-f32 (slice xs 0 0)))          ;

  (let [xs [(f32 1.0) (f32 2.0) (f32 3.0) (f32 4.0)]]
    (reverse-f32! (slice xs 0 4))
    (show-f32 (slice xs 0 4)))          ; 4 3 2 1

  ;; min, max and sum. The empty slice is None for the first two -- there is no
  ;; least f32 that is also an honest answer -- and the sum accumulates in f64,
  ;; which is why 16777216 + 1 does not absorb here the way it would in f32.
  (let [xs [(f32 3.5) (f32 -1.0) (f32 10.0)]]
    (match (min-f32 (slice xs 0 3)) (Some m) (print m) None (print "none"))
    (print " ")
    (match (max-f32 (slice xs 0 3)) (Some m) (print m) None (print "none"))
    (print " ")
    (print (sum-f32 (slice xs 0 3)))
    (println ""))                       ; -1 10 12.5
  (let [xs [(f32 1.0)]]
    (match (min-f32 (slice xs 0 0)) (Some m) (print m) None (print "none"))
    (print " ")
    (print (sum-f32 (slice xs 0 0)))
    (println ""))                       ; none 0
  ;; The accumulator's width, made visible. 2^24 is where an f32 stops having
  ;; a bit for 1, so an f32 running total absorbs both of these and the
  ;; difference below is 0. In f64 they both land, and it is 2.
  (let [xs [(f32 16777216.0) (f32 1.0) (f32 1.0)]]
    (print (- (sum-f32 (slice xs 0 3)) 16777216.0))
    (println ""))                       ; 2

  ;; bytes<? is bytewise and unsigned, and explicitly not alphabetical: "Zebra"
  ;; comes before "apple" because 'Z' is 90. A prefix comes before what extends
  ;; it, which is the case a loop running only to (len a) reads off the end
  ;; for, and 0x80 above 0x00 is the case a signed byte gets backwards.
  (print (bytes<? (bytes "a") (bytes "b"))) (print " ")      ; true
  (print (bytes<? (bytes "b") (bytes "a"))) (print " ")      ; false
  (print (bytes<? (bytes "a") (bytes "a"))) (print " ")      ; false
  (print (bytes<? (bytes "ab") (bytes "abc"))) (print " ")   ; true
  (print (bytes<? (bytes "abc") (bytes "ab"))) (print " ")   ; false
  (print (bytes<? (bytes "") (bytes "a"))) (print " ")       ; true
  (print (bytes<? (bytes "Zebra") (bytes "apple")))          ; true
  (println "")
  ;; 0x00 below 0x80, which is the pair a comparison over a *signed* byte gets
  ;; backwards -- and there is no \x escape in the reader, so these are built
  ;; as u8 arrays rather than written as string literals.
  (let [lo [(u8 0)]
        hi [(u8 128)]]
    (print (bytes<? (slice lo 0 1) (slice hi 0 1))) (print " ")   ; true
    (print (bytes<? (slice hi 0 1) (slice lo 0 1)))               ; false
    (println ""))

  ;; sort-bytes! over the fields split out of one buffer. The slices move and
  ;; the bytes never do, so this sorts a borrowed view of a string literal --
  ;; which an in-place byte sort could not, since a literal lives in .rodata.
  (let [f (split (bytes "pear,apple,Fig,apple,banana") \,)]
    (sort-bytes! (as-slice f))
    (show-fields (as-slice f))          ; Fig apple apple banana pear
    (free f))

  ;; And the round trip the whole second tier is for: split, sort, join.
  (let [f (split (bytes "delta,alpha,charlie,bravo") \,)]
    (sort-bytes! (as-slice f))
    (let [j (join (as-slice f) (bytes " < "))]
      (println (string (as-slice j)))   ; alpha < bravo < charlie < delta
      (free j))
    (free f))
  0)