(.module: {#.doc "Implementations of common structures for Lux's primitive number types."}
  lux
  (lux (control number
                [monoid (#+ Monoid)]
                [equivalence (#+ Equivalence)]
                hash
                [order]
                enum
                interval
                [codec (#+ Codec)])
       (data ["e" error]
             [maybe]
             [bit])))

## [Structures]
(do-template [<type> <test>]
  [(structure: #export _ (Equivalence <type>)
     (def: = <test>))]

  [ Nat n/=]
  [ Int i/=]
  [ Rev r/=]
  [Frac f/=]
  )

(do-template [<type> <eq> <lt> <lte> <gt> <gte>]
  [(structure: #export _ (order.Order <type>)
     (def: eq <eq>)
     (def: < <lt>)
     (def: <= <lte>)
     (def: > <gt>)
     (def: >= <gte>))]

  [ Nat Equivalence<Nat>  n/< n/<= n/> n/>=]
  [ Int Equivalence<Int>  i/< i/<= i/> i/>=]
  [Rev  Equivalence<Rev>  r/< r/<= r/> r/>=]
  [Frac Equivalence<Frac> f/< f/<= f/> f/>=]
  )

(structure: #export _ (Number Nat)
  (def: + n/+)
  (def: - n/-)
  (def: * n/*)
  (def: / n//)
  (def: % n/%)
  (def: negate id)
  (def: abs id)
  (def: (signum x)
    (case x
      +0 +0
      _  +1))
  )

(do-template [<type> <order> <+> <-> <*> </> <%> <=> <<> <0> <1> <-1>]
  [(structure: #export _ (Number <type>)
     (def: + <+>)
     (def: - <->)
     (def: * <*>)
     (def: / </>)
     (def: % <%>)
     (def: negate (<*> <-1>))
     (def: (abs x)
       (if (<<> <0> x)
         (<*> <-1> x)
         x))
     (def: (signum x)
       (cond (<=> <0> x) <0>
             (<<> <0> x) <-1>
             ## else
             <1>))
     )]

  [ Int  Order<Int> i/+ i/- i/* i// i/% i/= i/<   0   1   -1]
  [Frac Order<Frac> f/+ f/- f/* f// f/% f/= f/< 0.0 1.0 -1.0]
  )

(structure: #export _ (Number Rev)
  (def: + r/+)
  (def: - r/-)
  (def: * r/*)
  (def: / r//)
  (def: % r/%)
  (def: (negate x) (r/- x (:coerce Rev -1)))
  (def: abs id)
  (def: (signum x)
    (:coerce Rev -1)))

(do-template [<type> <order> <succ> <pred>]
  [(structure: #export _ (Enum <type>)
     (def: order <order>)
     (def: succ <succ>)
     (def: pred <pred>))]

  [Nat  Order<Nat>  inc dec]
  [Int  Order<Int>  inc dec]
  [Frac Order<Frac> (f/+ ("lux frac smallest")) (f/- ("lux frac smallest"))]
  [Rev  Order<Rev>  inc dec]
  )

(do-template [<type> <enum> <top> <bottom>]
  [(structure: #export _ (Interval <type>)
     (def: enum <enum>)
     (def: top <top>)
     (def: bottom <bottom>))]

  [ Nat Enum<Nat>  (:coerce Nat -1) +0]
  [ Int Enum<Int>  9_223_372_036_854_775_807 -9_223_372_036_854_775_808]
  [Frac Enum<Frac> ("lux frac max") ("lux frac min")]
  [ Rev Enum<Rev>  (:coerce Rev -1) (:coerce Rev +0)]
  )

(do-template [<name> <type> <identity> <compose>]
  [(structure: #export <name> (Monoid <type>)
     (def: identity <identity>)
     (def: compose <compose>))]

  [ Add@Monoid<Nat>  Nat +0                         n/+]
  [ Mul@Monoid<Nat>  Nat +1                         n/*]
  [ Max@Monoid<Nat>  Nat (:: Interval<Nat> bottom)  n/max]
  [ Min@Monoid<Nat>  Nat (:: Interval<Nat> top)     n/min]
  [ Add@Monoid<Int>  Int 0                          i/+]
  [ Mul@Monoid<Int>  Int 1                          i/*]
  [ Max@Monoid<Int>  Int (:: Interval<Int> bottom)  i/max]
  [ Min@Monoid<Int>  Int (:: Interval<Int> top)     i/min]
  [Add@Monoid<Frac> Frac 0.0                        f/+]
  [Mul@Monoid<Frac> Frac 1.0                        f/*]
  [Max@Monoid<Frac> Frac (:: Interval<Frac> bottom) f/max]
  [Min@Monoid<Frac> Frac (:: Interval<Frac> top)    f/min]
  [ Add@Monoid<Rev>  Rev (:: Interval<Rev> bottom)  r/+]
  [ Mul@Monoid<Rev>  Rev (:: Interval<Rev> top)     r/*]
  [ Max@Monoid<Rev>  Rev (:: Interval<Rev> bottom)  r/max]
  [ Min@Monoid<Rev>  Rev (:: Interval<Rev> top)     r/min]
  )

(do-template [<name> <numerator> <doc>]
  [(def: #export <name>
     {#.doc <doc>}
     Frac
     (f// 0.0 <numerator>))]

  [not-a-number       0.0      "Not a number."]
  [positive-infinity  1.0 "Positive infinity."]
  [negative-infinity -1.0 "Negative infinity."]
  )

(def: #export (not-a-number? number)
  {#.doc "Tests whether a frac is actually not-a-number."}
  (-> Frac Bool)
  (not (f/= number number)))

(def: #export (frac? value)
  (-> Frac Bool)
  (not (or (not-a-number? value)
           (f/= positive-infinity value)
           (f/= negative-infinity value))))

(do-template [<type> <encoder> <decoder> <error>]
  [(structure: #export _ (Codec Text <type>)
     (def: (encode x)
       (<encoder> [x]))

     (def: (decode input)
       (case (<decoder> [input])
         (#.Some value)
         (#e.Success value)

         #.None
         (#e.Error <error>))))]

  [Frac "lux frac encode" "lux frac decode" "Could not decode Frac"]
  )

## [Values & Syntax]
(def: (get-char full idx)
  (-> Text Nat (Maybe Text))
  ("lux text clip" full idx (inc idx)))

(def: (binary-character value)
  (-> Nat (Maybe Text))
  (case value
    +0 (#.Some "0")
    +1 (#.Some "1")
    _ #.None))

(def: (binary-value digit)
  (-> Text (Maybe Nat))
  (case digit
    "0" (#.Some +0)
    "1" (#.Some +1)
    _ #.None))

(def: (octal-character value)
  (-> Nat (Maybe Text))
  (case value
    +0 (#.Some "0")
    +1 (#.Some "1")
    +2 (#.Some "2")
    +3 (#.Some "3")
    +4 (#.Some "4")
    +5 (#.Some "5")
    +6 (#.Some "6")
    +7 (#.Some "7")
    _ #.None))

(def: (octal-value digit)
  (-> Text (Maybe Nat))
  (case digit
    "0" (#.Some +0)
    "1" (#.Some +1)
    "2" (#.Some +2)
    "3" (#.Some +3)
    "4" (#.Some +4)
    "5" (#.Some +5)
    "6" (#.Some +6)
    "7" (#.Some +7)
    _ #.None))

(def: (decimal-character value)
  (-> Nat (Maybe Text))
  (case value
    +0 (#.Some "0")
    +1 (#.Some "1")
    +2 (#.Some "2")
    +3 (#.Some "3")
    +4 (#.Some "4")
    +5 (#.Some "5")
    +6 (#.Some "6")
    +7 (#.Some "7")
    +8 (#.Some "8")
    +9 (#.Some "9")
    _ #.None))

(def: (decimal-value digit)
  (-> Text (Maybe Nat))
  (case digit
    "0" (#.Some +0)
    "1" (#.Some +1)
    "2" (#.Some +2)
    "3" (#.Some +3)
    "4" (#.Some +4)
    "5" (#.Some +5)
    "6" (#.Some +6)
    "7" (#.Some +7)
    "8" (#.Some +8)
    "9" (#.Some +9)
    _ #.None))

(def: (hexadecimal-character value)
  (-> Nat (Maybe Text))
  (case value
    +0 (#.Some "0")
    +1 (#.Some "1")
    +2 (#.Some "2")
    +3 (#.Some "3")
    +4 (#.Some "4")
    +5 (#.Some "5")
    +6 (#.Some "6")
    +7 (#.Some "7")
    +8 (#.Some "8")
    +9 (#.Some "9")
    +10 (#.Some "A")
    +11 (#.Some "B")
    +12 (#.Some "C")
    +13 (#.Some "D")
    +14 (#.Some "E")
    +15 (#.Some "F")
    _ #.None))

(def: (hexadecimal-value digit)
  (-> Text (Maybe Nat))
  (case digit
    "0" (#.Some +0)
    "1" (#.Some +1)
    "2" (#.Some +2)
    "3" (#.Some +3)
    "4" (#.Some +4)
    "5" (#.Some +5)
    "6" (#.Some +6)
    "7" (#.Some +7)
    "8" (#.Some +8)
    "9" (#.Some +9)
    (^or "a" "A") (#.Some +10)
    (^or "b" "B") (#.Some +11)
    (^or "c" "C") (#.Some +12)
    (^or "d" "D") (#.Some +13)
    (^or "e" "E") (#.Some +14)
    (^or "f" "F") (#.Some +15)
    _ #.None))

(do-template [<struct> <base> <to-character> <to-value> <error>]
  [(structure: #export <struct> (Codec Text Nat)
     (def: (encode value)
       (loop [input value
              output ""]
         (let [digit (maybe.assume (<to-character> (n/% <base> input)))
               output' ("lux text concat" digit output)
               input' (n// <base> input)]
           (if (n/= +0 input')
             ("lux text concat" "+" output')
             (recur input' output')))))

     (def: (decode repr)
       (let [input-size ("lux text size" repr)]
         (if (n/>= +2 input-size)
           (case ("lux text char" repr +0)
             (^ (#.Some (char "+")))
             (loop [idx +1
                    output +0]
               (if (n/< input-size idx)
                 (let [digit (maybe.assume (get-char repr idx))]
                   (case (<to-value> digit)
                     #.None
                     (#e.Error ("lux text concat" <error> repr))

                     (#.Some digit-value)
                     (recur (inc idx)
                            (|> output (n/* <base>) (n/+ digit-value)))))
                 (#e.Success output)))

             _
             (#e.Error ("lux text concat" <error> repr)))
           (#e.Error ("lux text concat" <error> repr))))))]

  [Binary@Codec<Text,Nat> +2  binary-character      binary-value      "Invalid binary syntax for Nat: "]
  [Octal@Codec<Text,Nat>  +8  octal-character       octal-value       "Invalid octal syntax for Nat: "]
  [_                      +10 decimal-character     decimal-value     "Invalid syntax for Nat: "]
  [Hex@Codec<Text,Nat>    +16 hexadecimal-character hexadecimal-value "Invalid hexadecimal syntax for Nat: "]
  )

(do-template [<struct> <base> <to-character> <to-value> <error>]
  [(structure: #export <struct> (Codec Text Int)
     (def: (encode value)
       (if (i/= 0 value)
         "0"
         (let [sign (if (i/< 0 value)
                      "-"
                      "")]
           (loop [input (|> value (i// <base>) (:: Number<Int> abs))
                  output (|> value (i/% <base>) (:: Number<Int> abs) .nat
                             <to-character>
                             maybe.assume)]
             (if (i/= 0 input)
               ("lux text concat" sign output)
               (let [digit (maybe.assume (<to-character> (.nat (i/% <base> input))))]
                 (recur (i// <base> input)
                        ("lux text concat" digit output))))))))

     (def: (decode repr)
       (let [input-size ("lux text size" repr)]
         (if (n/>= +1 input-size)
           (let [sign (case (get-char repr +0)
                        (^ (#.Some "-"))
                        -1

                        _
                        1)]
             (loop [idx (if (i/= -1 sign) +1 +0)
                    output 0]
               (if (n/< input-size idx)
                 (let [digit (maybe.assume (get-char repr idx))]
                   (case (<to-value> digit)
                     #.None
                     (#e.Error <error>)

                     (#.Some digit-value)
                     (recur (inc idx)
                            (|> output (i/* <base>) (i/+ (:coerce Int digit-value))))))
                 (#e.Success (i/* sign output)))))
           (#e.Error <error>)))))]

  [Binary@Codec<Text,Int> 2  binary-character      binary-value      "Invalid binary syntax for Int: "]
  [Octal@Codec<Text,Int>  8  octal-character       octal-value       "Invalid octal syntax for Int: "]
  [_                      10 decimal-character     decimal-value     "Invalid syntax for Int: "]
  [Hex@Codec<Text,Int>    16 hexadecimal-character hexadecimal-value "Invalid hexadecimal syntax for Int: "]
  )

(def: (de-prefix input)
  (-> Text Text)
  (maybe.assume ("lux text clip" input +1 ("lux text size" input))))

(do-template [<struct> <nat> <char-bit-size> <error>]
  [(structure: #export <struct> (Codec Text Rev)
     (def: (encode value)
       (let [raw-output (de-prefix (:: <nat> encode (:coerce Nat value)))
             max-num-chars (n// <char-bit-size> +64)
             raw-size ("lux text size" raw-output)
             zero-padding (loop [zeroes-left (n/- raw-size max-num-chars)
                                 output ""]
                            (if (n/= +0 zeroes-left)
                              output
                              (recur (dec zeroes-left)
                                     ("lux text concat" "0" output))))
             padded-output ("lux text concat" zero-padding raw-output)]
         ("lux text concat" "." padded-output)))

     (def: (decode repr)
       (let [repr-size ("lux text size" repr)]
         (if (n/>= +2 repr-size)
           (case ("lux text char" repr +0)
             (^multi (^ (#.Some (char ".")))
                     [(:: <nat> decode ("lux text concat" "+" (de-prefix repr)))
                      (#e.Success output)])
             (#e.Success (:coerce Rev output))

             _
             (#e.Error ("lux text concat" <error> repr)))
           (#e.Error ("lux text concat" <error> repr))))))]

  [Binary@Codec<Text,Rev> Binary@Codec<Text,Nat> +1 "Invalid binary syntax: "]
  [Octal@Codec<Text,Rev>  Octal@Codec<Text,Nat>  +3 "Invalid octal syntax: "]
  [Hex@Codec<Text,Rev>    Hex@Codec<Text,Nat>    +4 "Invalid hexadecimal syntax: "]
  )

(do-template [<struct> <int> <base> <char-set> <error>]
  [(structure: #export <struct> (Codec Text Frac)
     (def: (encode value)
       (let [whole (frac-to-int value)
             whole-part (:: <int> encode whole)
             decimal (:: Number<Frac> abs (f/% 1.0 value))
             decimal-part (if (f/= 0.0 decimal)
                            ".0"
                            (loop [dec-left decimal
                                   output ""]
                              (if (f/= 0.0 dec-left)
                                ("lux text concat" "." output)
                                (let [shifted (f/* <base> dec-left)
                                      digit (|> shifted (f/% <base>) frac-to-int .nat
                                                (get-char <char-set>) maybe.assume)]
                                  (recur (f/% 1.0 shifted)
                                         ("lux text concat" output digit))))))]
         ("lux text concat" whole-part decimal-part)))

     (def: (decode repr)
       (case ("lux text index" repr "." +0)
         (#.Some split-index)
         (let [whole-part (maybe.assume ("lux text clip" repr +0 split-index))
               decimal-part (maybe.assume ("lux text clip" repr (inc split-index) ("lux text size" repr)))]
           (case [(:: <int> decode whole-part)
                  (:: <int> decode decimal-part)]
             (^multi [(#e.Success whole) (#e.Success decimal)]
                     (i/>= 0 decimal))
             (let [sign (if (i/< 0 whole)
                          -1.0
                          1.0)
                   div-power (loop [muls-left ("lux text size" decimal-part)
                                    output 1.0]
                               (if (n/= +0 muls-left)
                                 output
                                 (recur (dec muls-left)
                                        (f/* <base> output))))
                   adjusted-decimal (|> decimal int-to-frac (f// div-power))
                   dec-rev (case (:: Hex@Codec<Text,Rev> decode ("lux text concat" "." decimal-part))
                             (#e.Success dec-rev)
                             dec-rev

                             (#e.Error error)
                             (error! error))]
               (#e.Success (f/+ (int-to-frac whole)
                                (f/* sign adjusted-decimal))))

             _
             (#e.Error ("lux text concat" <error> repr))))

         _
         (#e.Error ("lux text concat" <error> repr)))))]

  [Binary@Codec<Text,Frac> Binary@Codec<Text,Int> 2.0 "01" "Invalid binary syntax: "]
  )

(def: (segment-digits chunk-size digits)
  (-> Nat Text (List Text))
  (case digits
    ""
    (list)

    _
    (let [num-digits ("lux text size" digits)]
      (if (n/<= chunk-size num-digits)
        (list digits)
        (let [boundary (n/- chunk-size num-digits)
              chunk (maybe.assume ("lux text clip" digits boundary num-digits))
              remaining (maybe.assume ("lux text clip" digits +0 boundary))]
          (list& chunk (segment-digits chunk-size remaining)))))))

(def: (bin-segment-to-hex input)
  (-> Text Text)
  (case input
    "0000" "0"
    "0001" "1"
    "0010" "2"
    "0011" "3"
    "0100" "4"
    "0101" "5"
    "0110" "6"
    "0111" "7"
    "1000" "8"
    "1001" "9"
    "1010" "A"
    "1011" "B"
    "1100" "C"
    "1101" "D"
    "1110" "E"
    "1111" "F"
    _ (undefined)))

(def: (hex-segment-to-bin input)
  (-> Text Text)
  (case input
    "0" "0000"
    "1" "0001"
    "2" "0010"
    "3" "0011"
    "4" "0100"
    "5" "0101"
    "6" "0110"
    "7" "0111"
    "8" "1000"
    "9" "1001"
    (^or "a" "A") "1010"
    (^or "b" "B") "1011"
    (^or "c" "C") "1100"
    (^or "d" "D") "1101"
    (^or "e" "E") "1110"
    (^or "f" "F") "1111"
    _ (undefined)))

(def: (bin-segment-to-octal input)
  (-> Text Text)
  (case input
    "000" "0"
    "001" "1"
    "010" "2"
    "011" "3"
    "100" "4"
    "101" "5"
    "110" "6"
    "111" "7"
    _ (undefined)))

(def: (octal-segment-to-bin input)
  (-> Text Text)
  (case input
    "0" "000"
    "1" "001"
    "2" "010"
    "3" "011"
    "4" "100"
    "5" "101"
    "6" "110"
    "7" "111"
    _ (undefined)))

(def: (map f xs)
  (All [a b] (-> (-> a b) (List a) (List b)))
  (case xs
    #.Nil
    #.Nil
    
    (#.Cons x xs')
    (#.Cons (f x) (map f xs'))))

(def: (re-join-chunks xs)
  (-> (List Text) Text)
  (case xs
    #.Nil
    ""

    (#.Cons x xs')
    ("lux text concat" x (re-join-chunks xs'))))

(do-template [<from> <from-translator> <to> <to-translator> <base-bits>]
  [(def: (<from> on-left? input)
     (-> Bool Text Text)
     (let [max-num-chars (n// <base-bits> +64)
           input-size ("lux text size" input)
           zero-padding (let [num-digits-that-need-padding (n/% <base-bits> input-size)]
                          (if (n/= +0 num-digits-that-need-padding)
                            ""
                            (loop [zeroes-left (n/- num-digits-that-need-padding
                                                    <base-bits>)
                                   output ""]
                              (if (n/= +0 zeroes-left)
                                output
                                (recur (dec zeroes-left)
                                       ("lux text concat" "0" output))))))
           padded-input (if on-left?
                          ("lux text concat" zero-padding input)
                          ("lux text concat" input zero-padding))]
       (|> padded-input
           (segment-digits <base-bits>)
           (map <from-translator>)
           re-join-chunks)))

   (def: <to>
     (-> Text Text)
     (|>> (segment-digits +1)
          (map <to-translator>)
          re-join-chunks))]

  [binary-to-hex   bin-segment-to-hex   hex-to-binary   hex-segment-to-bin   +4]
  [binary-to-octal bin-segment-to-octal octal-to-binary octal-segment-to-bin +3]
  )

(do-template [<struct> <error> <from> <to>]
  [(structure: #export <struct> (Codec Text Frac)
     (def: (encode value)
       (let [sign (:: Number<Frac> signum value)
             raw-bin (:: Binary@Codec<Text,Frac> encode value)
             dot-idx (maybe.assume ("lux text index" raw-bin "." +0))
             whole-part (maybe.assume ("lux text clip" raw-bin
                                       (if (f/= -1.0 sign) +1 +0)
                                       dot-idx))
             decimal-part (maybe.assume ("lux text clip" raw-bin (inc dot-idx) ("lux text size" raw-bin)))
             hex-output (|> (<from> false decimal-part)
                            ("lux text concat" ".")
                            ("lux text concat" (<from> true whole-part))
                            ("lux text concat" (if (f/= -1.0 sign) "-" "")))]
         hex-output))

     (def: (decode repr)
       (let [sign (case ("lux text index" repr "-" +0)
                    (#.Some +0)
                    -1.0

                    _
                    1.0)]
         (case ("lux text index" repr "." +0)
           (#.Some split-index)
           (let [whole-part (maybe.assume ("lux text clip" repr (if (f/= -1.0 sign) +1 +0) split-index))
                 decimal-part (maybe.assume ("lux text clip" repr (inc split-index) ("lux text size" repr)))
                 as-binary (|> (<to> decimal-part)
                               ("lux text concat" ".")
                               ("lux text concat" (<to> whole-part))
                               ("lux text concat" (if (f/= -1.0 sign) "-" "")))]
             (case (:: Binary@Codec<Text,Frac> decode as-binary)
               (#e.Error _)
               (#e.Error ("lux text concat" <error> repr))

               output
               output))

           _
           (#e.Error ("lux text concat" <error> repr))))))]

  [Octal@Codec<Text,Frac> "Invalid octaladecimal syntax: " binary-to-octal octal-to-binary]
  [Hex@Codec<Text,Frac>   "Invalid hexadecimal syntax: "   binary-to-hex   hex-to-binary]
  )

(macro: (encoding-doc tokens state)
  (case tokens
    (^ (list [cursor (#.Text encoding)] example-1 example-2))
    (let [encoding ($_ "lux text concat"
                       "Given syntax for a "
                       encoding
                       " number, generates a Nat, an Int, a Rev or a Frac.")
          underscore "Allows for the presence of underscore in the numbers."
          description [cursor (#.Text ($_ "lux text concat"
                                          encoding "\n"
                                          underscore))]]
      (#e.Success [state (list (` (doc (~ description)
                                       (~ example-1)
                                       (~ example-2))))]))

    _
    (#e.Error "Wrong syntax for \"encoding-doc\".")))

(def: (underscore-prefixed? number)
  (-> Text Bool)
  (case ("lux text index" number "_" +0)
    (#.Some +0)
    true

    _
    false))

(def: (clean-underscores number)
  (-> Text Text)
  ("lux text replace-all" number "_" ""))

(do-template [<macro> <nat> <int> <rev> <frac> <error> <doc>]
  [(macro: #export (<macro> tokens state)
     {#.doc <doc>}
     (case tokens
       (#.Cons [meta (#.Text repr')] #.Nil)
       (if (underscore-prefixed? repr')
         (#e.Error <error>)
         (let [repr (clean-underscores repr')]
           (case (:: <nat> decode repr)
             (#e.Success value)
             (#e.Success [state (list [meta (#.Nat value)])])

             (^multi (#e.Error _)
                     [(:: <int> decode repr) (#e.Success value)])
             (#e.Success [state (list [meta (#.Int value)])])

             (^multi (#e.Error _)
                     [(:: <rev> decode repr) (#e.Success value)])
             (#e.Success [state (list [meta (#.Rev value)])])

             (^multi (#e.Error _)
                     [(:: <frac> decode repr) (#e.Success value)])
             (#e.Success [state (list [meta (#.Frac value)])])

             _
             (#e.Error <error>))))

       _
       (#e.Error <error>)))]

  [bin Binary@Codec<Text,Nat> Binary@Codec<Text,Int> Binary@Codec<Text,Rev> Binary@Codec<Text,Frac>
   "Invalid binary syntax."
   (encoding-doc "binary" (bin "11001001") (bin "11_00_10_01"))]
  [oct Octal@Codec<Text,Nat>  Octal@Codec<Text,Int>  Octal@Codec<Text,Rev>  Octal@Codec<Text,Frac>
   "Invalid octal syntax."
   (encoding-doc "octal" (oct "615243") (oct "615_243"))]
  [hex Hex@Codec<Text,Nat>    Hex@Codec<Text,Int>    Hex@Codec<Text,Rev>    Hex@Codec<Text,Frac>
   "Invalid hexadecimal syntax."
   (encoding-doc "hexadecimal" (hex "deadBEEF") (hex "dead_BEEF"))]
  )

## The following code allows one to encode/decode Rev numbers as text.
## This is not a simple algorithm, and it requires subverting the Rev
## abstraction a bit.
## It takes into account the fact that Rev numbers are represented by
## Lux as 64-bit integers.
## A valid way to model them is as Lux's Nat type.
## This is a somewhat hackish way to do things, but it allows one to
## write the encoding/decoding algorithm once, in pure Lux, rather
## than having to implement it on the compiler for every platform
## targeted by Lux.
(type: Digits (Array Nat))

(def: (make-digits _)
  (-> Any Digits)
  ("lux array new" bit.width))

(def: (digits-get idx digits)
  (-> Nat Digits Nat)
  (maybe.default +0 ("lux array get" digits idx)))

(def: (digits-put idx digit digits)
  (-> Nat Nat Digits Digits)
  ("lux array put" digits idx digit))

(def: (prepend left right)
  (-> Text Text Text)
  ("lux text concat" left right))

(def: (digits-times-5! idx output)
  (-> Nat Digits Digits)
  (loop [idx idx
         carry +0
         output output]
    (if (i/>= 0 (:coerce Int idx))
      (let [raw (|> (digits-get idx output)
                    (n/* +5)
                    (n/+ carry))]
        (recur (dec idx)
               (n// +10 raw)
               (digits-put idx (n/% +10 raw) output)))
      output)))

(def: (digits-power power)
  (-> Nat Digits)
  (loop [times power
         output (|> (make-digits [])
                    (digits-put power +1))]
    (if (i/>= 0 (:coerce Int times))
      (recur (dec times)
             (digits-times-5! power output))
      output)))

(def: (digits-to-text digits)
  (-> Digits Text)
  (loop [idx (dec bit.width)
         all-zeroes? true
         output ""]
    (if (i/>= 0 (:coerce Int idx))
      (let [digit (digits-get idx digits)]
        (if (and (n/= +0 digit)
                 all-zeroes?)
          (recur (dec idx) true output)
          (recur (dec idx)
                 false
                 ("lux text concat"
                  (:: Codec<Text,Int> encode (:coerce Int digit))
                  output))))
      (if all-zeroes?
        "0"
        output))))

(def: (digits-add param subject)
  (-> Digits Digits Digits)
  (loop [idx (dec bit.width)
         carry +0
         output (make-digits [])]
    (if (i/>= 0 (:coerce Int idx))
      (let [raw ($_ n/+
                    carry
                    (digits-get idx param)
                    (digits-get idx subject))]
        (recur (dec idx)
               (n// +10 raw)
               (digits-put idx (n/% +10 raw) output)))
      output)))

(def: (text-to-digits input)
  (-> Text (Maybe Digits))
  (let [length ("lux text size" input)]
    (if (n/<= bit.width length)
      (loop [idx +0
             output (make-digits [])]
        (if (n/< length idx)
          (let [char (maybe.assume (get-char input idx))]
            (case ("lux text index" "0123456789" char +0)
              #.None
              #.None

              (#.Some digit)
              (recur (inc idx)
                     (digits-put idx digit output))))
          (#.Some output)))
      #.None)))

(def: (digits-lt param subject)
  (-> Digits Digits Bool)
  (loop [idx +0]
    (and (n/< bit.width idx)
         (let [pd (digits-get idx param)
               sd (digits-get idx subject)]
           (if (n/= pd sd)
             (recur (inc idx))
             (n/< pd sd))))))

(def: (digits-sub-once! idx param subject)
  (-> Nat Nat Digits Digits)
  (let [sd (digits-get idx subject)]
    (if (n/>= param sd)
      (digits-put idx (n/- param sd) subject)
      (let [diff (|> sd
                     (n/+ +10)
                     (n/- param))]
        (|> subject
            (digits-put idx diff)
            (digits-sub-once! (dec idx) +1))))))

(def: (digits-sub! param subject)
  (-> Digits Digits Digits)
  (loop [idx (dec bit.width)
         output subject]
    (if (i/>= 0 (.int idx))
      (recur (dec idx)
             (digits-sub-once! idx (digits-get idx param) output))
      output)))

(structure: #export _ (Codec Text Rev)
  (def: (encode input)
    (let [input (:coerce Nat input)
          last-idx (dec bit.width)]
      (if (n/= +0 input)
        ".0"
        (loop [idx last-idx
               digits (make-digits [])]
          (if (i/>= 0 (:coerce Int idx))
            (if (bit.set? idx input)
              (let [digits' (digits-add (digits-power (n/- idx last-idx))
                                        digits)]
                (recur (dec idx)
                       digits'))
              (recur (dec idx)
                     digits))
            ("lux text concat" "." (digits-to-text digits))
            )))))

  (def: (decode input)
    (let [length ("lux text size" input)
          dotted? (case ("lux text index" input "." +0)
                    (#.Some +0)
                    true

                    _
                    false)]
      (if (and dotted?
               (n/<= (inc bit.width) length))
        (case (|> ("lux text clip" input +1 length)
                  maybe.assume
                  text-to-digits)
          (#.Some digits)
          (loop [digits digits
                 idx +0
                 output +0]
            (if (n/< bit.width idx)
              (let [power (digits-power idx)]
                (if (digits-lt power digits)
                  ## Skip power
                  (recur digits (inc idx) output)
                  (recur (digits-sub! power digits)
                         (inc idx)
                         (bit.set (n/- idx (dec bit.width)) output))))
              (#e.Success (:coerce Rev output))))

          #.None
          (#e.Error ("lux text concat" "Wrong syntax for Rev: " input)))
        (#e.Error ("lux text concat" "Wrong syntax for Rev: " input))))
    ))

(def: (log2 input)
  (-> Frac Frac)
  (f// ("lux math log" 2.0)
       ("lux math log" input)))

(def: double-bias Nat +1023)

(def: mantissa-size Nat +52)
(def: exponent-size Nat +11)

(def: #export (frac-to-bits input)
  (-> Frac I64)
  (i64 (cond (not-a-number? input)
             (hex "+7FF7FFFFFFFFFFFF")

             (f/= positive-infinity input)
             (hex "+7FF0000000000000")

             (f/= negative-infinity input)
             (hex "+FFF0000000000000")

             (f/= 0.0 input)
             (let [reciprocal (f// input 1.0)]
               (if (f/= positive-infinity reciprocal)
                 ## Positive zero
                 (hex "+0000000000000000")
                 ## Negative zero
                 (hex "+8000000000000000")))

             ## else
             (let [sign (:: Number<Frac> signum input)
                   input (:: Number<Frac> abs input)
                   exponent ("lux math floor" (log2 input))
                   exponent-mask (|> +1 (bit.left-shift exponent-size) dec) 
                   mantissa (|> input
                                ## Normalize
                                (f// ("lux math pow" 2.0 exponent))
                                ## Make it int-equivalent
                                (f/* ("lux math pow" 2.0 52.0)))
                   sign-bit (if (f/= -1.0 sign) +1 +0)
                   exponent-bits (|> exponent frac-to-int .nat (n/+ double-bias) (bit.and exponent-mask))
                   mantissa-bits (|> mantissa frac-to-int .nat)]
               ($_ bit.or
                   (bit.left-shift +63 sign-bit)
                   (bit.left-shift mantissa-size exponent-bits)
                   (bit.clear mantissa-size mantissa-bits)))
             )))

(do-template [<getter> <mask> <size> <offset>]
  [(def: <mask> (|> +1 (bit.left-shift <size>) dec (bit.left-shift <offset>)))
   (def: (<getter> input)
     (-> (I64 Any) I64)
     (|> input (bit.and <mask>) (bit.logical-right-shift <offset>) i64))]

  [mantissa mantissa-mask mantissa-size +0]
  [exponent exponent-mask exponent-size mantissa-size]
  [sign     sign-mask     +1            (n/+ exponent-size mantissa-size)]
  )

(def: #export (bits-to-frac input)
  (-> (I64 Any) Frac)
  (let [S (sign input)
        E (exponent input)
        M (mantissa input)]
    (cond (n/= (hex "+7FF") E)
          (if (n/= +0 M)
            (if (n/= +0 S)
              positive-infinity
              negative-infinity)
            not-a-number)

          (and (n/= +0 E) (n/= +0 M))
          (if (n/= +0 S)
            0.0
            (f/* -1.0 0.0))

          ## else
          (let [normalized (|> M (bit.set mantissa-size)
                               .int int-to-frac
                               (f// ("lux math pow" 2.0 52.0)))
                power (|> E (n/- double-bias)
                          .int int-to-frac
                          ("lux math pow" 2.0))
                shifted (f/* power
                             normalized)]
            (if (n/= +0 S)
              shifted
              (f/* -1.0 shifted))))))

## [Hash]
(structure: #export _ (Hash Nat)
  (def: eq Equivalence<Nat>)
  (def: hash id))

(structure: #export _ (Hash Int)
  (def: eq Equivalence<Int>)
  (def: hash .nat))

(structure: #export _ (Hash Frac)
  (def: eq Equivalence<Frac>)
  
  (def: hash frac-to-bits))

(structure: #export _ (Hash Rev)
  (def: eq Equivalence<Rev>)
  (def: hash (|>> (:coerce Nat))))