path: root/stdlib/source/lux/data/number.lux

(;module: {#;doc "Implementations of common structures for Lux's primitive number types."}
  lux
  (lux (control number
                monoid
                [eq #+ Eq]
                hash
                [order]
                enum
                interval
                codec)
       (data ["R" result]
             [maybe]
             [bit])))

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

  [ Nat n.=]
  [ Int i.=]
  [ Deg d.=]
  [Frac f.=]
  )

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

  [ Nat Eq<Nat>  n.< n.<= n.> n.>=]
  [ Int Eq<Int>  i.< i.<= i.> i.>=]
  [Deg  Eq<Deg>  d.< d.<= d.> d.>=]
  [Frac Eq<Frac> f.< f.<= f.> f.>=]
  )

(struct: #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>]
  [(struct: #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]
  )

(struct: #export _ (Number Deg)
  (def: + d.+)
  (def: - d.-)
  (def: * d.*)
  (def: / d./)
  (def: % d.%)
  (def: (negate x) (d.- x (_lux_proc ["deg" "max-value"] [])))
  (def: abs id)
  (def: (signum x)
    (_lux_proc ["deg" "max-value"] []))
  )

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

  [Nat Order<Nat> n.inc n.dec]
  [Int Order<Int> i.inc i.dec]
  [Frac Order<Frac> (f.+ (_lux_proc [ "frac" "smallest-value"] [])) (f.- (_lux_proc [ "frac" "smallest-value"] []))]
  [Deg Order<Deg> (d.+ (_lux_proc [ "deg" "min-value"] [])) (d.- (_lux_proc [ "deg" "min-value"] []))]
  )

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

  [ Nat Enum<Nat>  (_lux_proc [ "nat" "max-value"] []) (_lux_proc [ "nat" "min-value"] [])]
  [ Int Enum<Int>  (_lux_proc [ "int" "max-value"] []) (_lux_proc [ "int" "min-value"] [])]
  [Frac Enum<Frac> (_lux_proc ["frac" "max-value"] []) (_lux_proc ["frac" "min-value"] [])]
  [ Deg Enum<Deg>  (_lux_proc [ "deg" "max-value"] []) (_lux_proc [ "deg" "min-value"] [])]
  )

(do-template [<name> <type> <unit> <append>]
  [(struct: #export <name> (Monoid <type>)
     (def: unit <unit>)
     (def: append <append>))]

  [ 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<Deg>  Deg (:: Interval<Deg> bottom)  d.+]
  [ Mul@Monoid<Deg>  Deg (:: Interval<Deg> top)     d.*]
  [ Max@Monoid<Deg>  Deg (:: Interval<Deg> bottom)  d.max]
  [ Min@Monoid<Deg>  Deg (:: Interval<Deg> top)     d.min]
  )

(do-template [<name> <const> <doc>]
  [(def: #export <name>
     {#;doc <doc>}
     Frac
     (_lux_proc ["frac" <const>] []))]

  [not-a-number      "not-a-number"      "Not-a-number."]
  [positive-infinity "positive-infinity" "Positive infinity."]
  [negative-infinity "negative-infinity" "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>]
  [(struct: #export _ (Codec Text <type>)
     (def: (encode x)
       (_lux_proc <encoder> [x]))

     (def: (decode input)
       (case (_lux_proc <decoder> [input])
         (#;Some value)
         (#R;Success value)

         #;None
         (#R;Error <error>))))]

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

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

(do-template [<struct> <base> <char-set> <error>]
  [(struct: #export <struct> (Codec Text Nat)
     (def: (encode value)
       (loop [input value
              output ""]
         (let [digit (maybe;assume (get-char <char-set> (n.% <base> input)))
               output' (_lux_proc ["text" "append"] [digit output])
               input' (n./ <base> input)]
           (if (n.= +0 input')
             (_lux_proc ["text" "append"] ["+" output'])
             (recur input' output')))))

     (def: (decode repr)
       (let [input-size (_lux_proc ["text" "size"] [repr])]
         (if (n.>= +2 input-size)
           (case (_lux_proc ["text" "char"] [repr +0])
             (^ (#;Some (char "+")))
             (let [input (_lux_proc ["text" "upper-case"] [repr])]
               (loop [idx +1
                      output +0]
                 (if (n.< input-size idx)
                   (let [digit (maybe;assume (get-char input idx))]
                     (case (_lux_proc ["text" "index"] [<char-set> digit +0])
                       #;None
                       (#R;Error (_lux_proc ["text" "append"] [<error> repr]))

                       (#;Some index)
                       (recur (n.inc idx)
                              (|> output (n.* <base>) (n.+ index)))))
                   (#R;Success output))))

             _
             (#R;Error (_lux_proc ["text" "append"] [<error> repr])))
           (#R;Error (_lux_proc ["text" "append"] [<error> repr]))))))]

  [Binary@Codec<Text,Nat> +2  "01"               "Invalid binary syntax for Nat: "]
  [Octal@Codec<Text,Nat>  +8  "01234567"         "Invalid octal syntax for Nat: "]
  [_                      +10 "0123456789"       "Invalid syntax for Nat: "]
  [Hex@Codec<Text,Nat>    +16 "0123456789ABCDEF" "Invalid hexadecimal syntax for Nat: "]
  )

(do-template [<struct> <base> <char-set> <error>]
  [(struct: #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) int-to-nat
                             (get-char <char-set>)
                             maybe;assume)]
             (if (i.= 0 input)
               (_lux_proc ["text" "append"] [sign output])
               (let [digit (maybe;assume (get-char <char-set> (int-to-nat (i.% <base> input))))]
                 (recur (i./ <base> input)
                        (_lux_proc ["text" "append"] [digit output]))))))))

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

                        _
                        1)
                 input (_lux_proc ["text" "upper-case"] [repr])]
             (loop [idx (if (i.= -1 sign) +1 +0)
                    output 0]
               (if (n.< input-size idx)
                 (let [digit (maybe;assume (get-char input idx))]
                   (case (_lux_proc ["text" "index"] [<char-set> digit +0])
                     #;None
                     (#R;Error <error>)

                     (#;Some index)
                     (recur (n.inc idx)
                            (|> output (i.* <base>) (i.+ (:! Int index))))))
                 (#R;Success (i.* sign output)))))
           (#R;Error <error>)))))]

  [Binary@Codec<Text,Int> 2  "01"               "Invalid binary syntax for Int: "]
  [Octal@Codec<Text,Int>  8  "01234567"         "Invalid octal syntax for Int: "]
  [_                      10 "0123456789"       "Invalid syntax for Int: "]
  [Hex@Codec<Text,Int>    16 "0123456789ABCDEF" "Invalid hexadecimal syntax for Int: "]
  )

(def: (de-prefix input)
  (-> Text Text)
  (maybe;assume (_lux_proc ["text" "clip"] [input +1 (_lux_proc ["text" "size"] [input])])))

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

     (def: (decode repr)
       (let [repr-size (_lux_proc ["text" "size"] [repr])]
         (if (n.>= +2 repr-size)
           (case (_lux_proc ["text" "char"] [repr +0])
             (^multi (^ (#;Some (char ".")))
                     [(:: <nat> decode (_lux_proc ["text" "append"] ["+" (de-prefix repr)]))
                      (#;Some output)])
             (#R;Success (:! Deg output))

             _
             (#R;Error (_lux_proc ["text" "append"] [<error> repr])))
           (#R;Error (_lux_proc ["text" "append"] [<error> repr]))))))]

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

(do-template [<struct> <int> <base> <char-set> <error>]
  [(struct: #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_proc ["text" "append"] ["." output])
                                (let [shifted (f.* <base> dec-left)
                                      digit (|> shifted (f.% <base>) frac-to-int int-to-nat
                                                (get-char <char-set>) maybe;assume)]
                                  (recur (f.% 1.0 shifted)
                                         (_lux_proc ["text" "append"] [output digit]))))))]
         (_lux_proc ["text" "append"] [whole-part decimal-part])))

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

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

             _
             (#R;Error (_lux_proc ["text" "append"] [<error> repr]))))

         _
         (#R;Error (_lux_proc ["text" "append"] [<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_proc ["text" "size"] [digits])]
      (if (n.<= chunk-size num-digits)
        (list digits)
        (let [boundary (n.- chunk-size num-digits)
              chunk (maybe;assume (_lux_proc ["text" "clip"] [digits boundary num-digits]))
              remaining (maybe;assume (_lux_proc ["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"
    "A" "1010"
    "B" "1011"
    "C" "1100"
    "D" "1101"
    "E" "1110"
    "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_proc ["text" "append"] [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_proc ["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 (n.dec zeroes-left)
                                       (_lux_proc ["text" "append"] ["0" output]))))))
           padded-input (if on-left?
                          (_lux_proc ["text" "append"] [zero-padding input])
                          (_lux_proc ["text" "append"] [input zero-padding]))]
       (|> padded-input
           (segment-digits <base-bits>)
           (map <from-translator>)
           re-join-chunks)))

   (def: (<to> input)
     (-> Text Text)
     (|> input
         (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>]
  [(struct: #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_proc ["text" "index"] [raw-bin "." +0]))
             whole-part (maybe;assume (_lux_proc ["text" "clip"] [raw-bin
                                                                  (if (f.= -1.0 sign) +1 +0)
                                                                  dot-idx]))
             decimal-part (maybe;assume (_lux_proc ["text" "clip"] [raw-bin (n.inc dot-idx) (_lux_proc ["text" "size"] [raw-bin])]))
             hex-output (|> (<from> false decimal-part)
                            ["."]
                            (_lux_proc ["text" "append"])
                            [(<from> true whole-part)]
                            (_lux_proc ["text" "append"])
                            [(if (f.= -1.0 sign) "-" "")]
                            (_lux_proc ["text" "append"]))]
         hex-output))

     (def: (decode repr)
       (let [sign (case (_lux_proc ["text" "index"] [repr "-" +0])
                    (#;Some +0)
                    -1.0

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

               output
               output))

           _
           (#R;Error (_lux_proc ["text" "append"] [<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]
  )

(do-template [<macro> <nat> <int> <deg> <frac> <error> <doc>]
  [(macro: #export (<macro> tokens state)
     {#;doc <doc>}
     (case tokens
       (#;Cons [meta (#;Text repr)] #;Nil)
       (case (:: <nat> decode repr)
         (#R;Success value)
         (#R;Success [state (list [meta (#;Nat value)])])

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

         (^multi (#R;Error _)
                 [(:: <deg> decode repr) (#R;Success value)])
         (#R;Success [state (list [meta (#;Deg value)])])

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

         _
         (#R;Error <error>))

       _
       (#R;Error <error>)))]

  [bin Binary@Codec<Text,Nat> Binary@Codec<Text,Int> Binary@Codec<Text,Deg> Binary@Codec<Text,Frac>
   "Invalid binary syntax."
   (doc "Given syntax for a binary number, generates a Nat, an Int, a Deg or a Frac."
        (bin "11001001"))]
  [oct Octal@Codec<Text,Nat>  Octal@Codec<Text,Int>  Octal@Codec<Text,Deg>  Octal@Codec<Text,Frac>
   "Invalid octal syntax."
   (doc "Given syntax for a octal number, generates a Nat, an Int, a Deg or a Frac."
        (oct "615243"))]
  [hex Hex@Codec<Text,Nat>    Hex@Codec<Text,Int>    Hex@Codec<Text,Deg>    Hex@Codec<Text,Frac>
   "Invalid hexadecimal syntax."
   (doc "Given syntax for a hexadecimal number, generates a Nat, an Int, a Deg or a Frac."
        (hex "deadBEEF"))]
  )

## The following code allows one to encode/decode Deg numbers as text.
## This is not a simple algorithm, and it requires subverting the Deg
## abstraction a bit.
## It takes into account the fact that Deg 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 (#;Host "#Array" (#;Cons Nat #;Nil)))

(def: (make-digits _)
  (-> Top Digits)
  (_lux_proc ["array" "new"] [bit;width]))

(def: (digits-get idx digits)
  (-> Nat Digits Nat)
  (maybe;default +0 (_lux_proc ["array" "get"] [digits idx])))

(def: (digits-put idx digit digits)
  (-> Nat Nat Digits Digits)
  (_lux_proc ["array" "put"] [digits idx digit]))

(def: (prepend left right)
  (-> Text Text Text)
  (_lux_proc ["text" "append"] [left right]))

(def: (digits-times-5! idx output)
  (-> Nat Digits Digits)
  (loop [idx idx
         carry +0
         output output]
    (if (i.>= 0 (:! Int idx))
      (let [raw (|> (digits-get idx output)
                    (n.* +5)
                    (n.+ carry))]
        (recur (n.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 (:! Int times))
      (recur (n.dec times)
             (digits-times-5! power output))
      output)))

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

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

(def: (text-to-digits input)
  (-> Text (Maybe Digits))
  (let [length (_lux_proc ["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_proc ["text" "index"] ["0123456789" char +0])
              #;None
              #;None

              (#;Some digit)
              (recur (n.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 (n.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! (n.dec idx) +1))))))

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

(struct: #export _ (Codec Text Deg)
  (def: (encode input)
    (let [input (:! Nat input)
          last-idx (n.dec bit;width)]
      (if (n.= +0 input)
        ".0"
        (loop [idx last-idx
               digits (make-digits [])]
          (if (i.>= 0 (:! Int idx))
            (if (bit;set? idx input)
              (let [digits' (digits-add (digits-power (n.- idx last-idx))
                                        digits)]
                (recur (n.dec idx)
                       digits'))
              (recur (n.dec idx)
                     digits))
            (_lux_proc ["text" "append"] ["." (digits-to-text digits)])
            )))))

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

                    _
                    false)]
      (if (and dotted?
               (n.<= (n.inc bit;width) length))
        (case (|> (_lux_proc ["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 (n.inc idx) output)
                  (recur (digits-sub! power digits)
                         (n.inc idx)
                         (bit;set (n.- idx (n.dec bit;width)) output))))
              (#R;Success (:! Deg output))))

          #;None
          (#R;Error (_lux_proc ["text" "append"] ["Wrong syntax for Deg: " input])))
        (#R;Error (_lux_proc ["text" "append"] ["Wrong syntax for Deg: " input]))))
    ))

(def: (log2 input)
  (-> Frac Frac)
  (f./ (_lux_proc ["math" "log"] [2.0])
       (_lux_proc ["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 Nat)
  (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_proc ["math" "floor"] [(log2 input)])
              exponent-mask (|> +1 (bit;shift-left exponent-size) n.dec) 
              mantissa (|> input
                           ## Normalize
                           (f./ (_lux_proc ["math" "pow"] [2.0 exponent]))
                           ## Make it int-equivalent
                           (f.* (_lux_proc ["math" "pow"] [2.0 52.0])))
              sign-bit (if (f.= -1.0 sign) +1 +0)
              exponent-bits (|> exponent frac-to-int int-to-nat (n.+ double-bias) (bit;and exponent-mask))
              mantissa-bits (|> mantissa frac-to-int int-to-nat)]
          ($_ bit;or
              (bit;shift-left +63 sign-bit)
              (bit;shift-left mantissa-size exponent-bits)
              (bit;clear mantissa-size mantissa-bits)))
        ))

(do-template [<getter> <mask> <size> <offset>]
  [(def: <mask> (|> +1 (bit;shift-left <size>) n.dec (bit;shift-left <offset>)))
   (def: (<getter> input)
     (-> Nat Nat)
     (|> input (bit;and <mask>) (bit;shift-right <offset>)))]

  [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)
  (-> Nat 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)
                               nat-to-int int-to-frac
                               (f./ (_lux_proc ["math" "pow"] [2.0 52.0])))
                power (|> E (n.- double-bias)
                          nat-to-int int-to-frac
                          [2.0] (_lux_proc ["math" "pow"]))
                shifted (f.* power
                             normalized)]
            (if (n.= +0 S)
              shifted
              (f.* -1.0 shifted))))))

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

(struct: #export _ (Hash Int)
  (def: eq Eq<Int>)
  (def: hash int-to-nat))

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

(struct: #export _ (Hash Deg)
  (def: eq Eq<Deg>)
  (def: hash (|>. (:! Nat))))