path: root/stdlib/source/library/lux/math/number/rev.lux

(.require
 [library
  [lux (.except)
   [abstract
    [hash (.only Hash)]
    [enum (.only Enum)]
    [interval (.only Interval)]
    [monoid (.only Monoid)]
    [equivalence (.only Equivalence)]
    [codec (.only Codec)]
    [order (.only Order)]]
   [control
    ["[0]" maybe]
    ["[0]" try]]
   [data
    [collection
     ["[0]" array (.only Array)]]]]]
 ["[0]" //
  ["[1][0]" i64]
  ["[1][0]" nat]
  ["[1][0]" int]])

(def .public /1
  Rev
  (.rev -1))

(with_template [<power> <name>]
  [(def .public <name>
     Rev
     (.rev (//i64.left_shifted (//nat.- <power> //i64.width) 1)))]

  [01 /2]
  [02 /4]
  [03 /8]
  [04 /16]
  [05 /32]
  [06 /64]
  [07 /128]
  [08 /256]
  [09 /512]
  [10 /1024]
  [11 /2048]
  [12 /4096]
  )

(def .public (= reference sample)
  (-> Rev Rev Bit)
  ("lux i64 =" reference sample))

(def .public (< reference sample)
  (-> Rev Rev Bit)
  (//nat.< (.nat reference) (.nat sample)))

(def .public (<= reference sample)
  (-> Rev Rev Bit)
  (or (//nat.< (.nat reference) (.nat sample))
      ("lux i64 =" reference sample)))

(def .public (> reference sample)
  (-> Rev Rev Bit)
  (..< sample reference))

(def .public (>= reference sample)
  (-> Rev Rev Bit)
  (or (..< sample reference)
      ("lux i64 =" reference sample)))

(with_template [<name> <test>]
  [(def .public (<name> left right)
     (-> Rev Rev Rev)
     (if (<test> right left)
       left
       right))]

  [min ..<]
  [max ..>]
  )

(with_template [<name> <op>]
  [(def .public (<name> param subject)
     (-> Rev Rev Rev)
     (<op> param subject))]

  [+ "lux i64 +"]
  [- "lux i64 -"]
  )

(def high
  (-> (I64 Any) I64)
  (|>> ("lux i64 right-shift" 32)))

(def low
  (-> (I64 Any) I64)
  (let [mask (|> 1 ("lux i64 left-shift" 32) ("lux i64 -" 1))]
    (|>> ("lux i64 and" mask))))

(def .public (* param subject)
  (-> Rev Rev Rev)
  (let [subjectH (..high subject)
        subjectL (..low subject)
        paramH (..high param)
        paramL (..low param)
        bottom (|> subjectL
                   ("lux i64 *" paramL)
                   ("lux i64 right-shift" 32))
        middle ("lux i64 +"
                ("lux i64 *" paramL subjectH)
                ("lux i64 *" paramH subjectL))
        top ("lux i64 *" subjectH paramH)]
    (|> bottom
        ("lux i64 +" middle)
        ..high
        ("lux i64 +" top))))

(def even_one (//i64.right_rotated 1 1))
(def odd_one (-- 0))

(def (even_reciprocal numerator)
  (-> Nat Nat)
  (//nat./ (//i64.right_shifted 1 numerator)
           ..even_one))

(def (odd_reciprocal numerator)
  (-> Nat Nat)
  (//nat./ numerator ..odd_one))

(with_expansions [<least_significant_bit> 1]
  (def .public (reciprocal numerator)
    (-> Nat Rev)
    (.rev (case (is Nat ("lux i64 and" <least_significant_bit> numerator))
            0 (..even_reciprocal numerator)
            _ (..odd_reciprocal numerator))))
  
  (def .public (/ param subject)
    (-> Rev Rev Rev)
    (if ("lux i64 =" +0 param)
      (panic! "Cannot divide Rev by zero!")
      (let [reciprocal (case (is Nat ("lux i64 and" <least_significant_bit> param))
                         0 (..even_reciprocal (.nat param))
                         _ (..odd_reciprocal (.nat param)))]
        (.rev (//nat.* reciprocal (.nat subject)))))))

(with_template [<operator> <name> <output> <output_type>]
  [(def .public (<name> param subject)
     (-> Rev Rev <output_type>)
     (<output> (<operator> (.nat param) (.nat subject))))]

  [//nat.% % .rev Rev]
  [//nat./ ratio |> Nat]
  )

(with_template [<operator> <name>]
  [(def .public (<name> scale subject)
     (-> Nat Rev Rev)
     (.rev (<operator> (.nat scale) (.nat subject))))]

  [//nat.* up]
  [//nat./ down]
  )

(def .public (/% param subject)
  (-> Rev Rev [Rev Rev])
  [(../ param subject)
   (..% param subject)])

(def mantissa
  (-> (I64 Any) Frac)
  (|>> ("lux i64 right-shift" 11)
       "lux i64 f64"))

(def frac_denominator
  (..mantissa -1))

(def .public frac
  (-> Rev Frac)
  (|>> ..mantissa ("lux f64 /" ..frac_denominator)))

(def .public equivalence
  (Equivalence Rev)
  (implementation
   (def = ..=)))

(def .public hash
  (Hash Rev)
  (implementation
   (def equivalence ..equivalence)
   (def hash (|>> .nat))))

(def .public order
  (Order Rev)
  (implementation
   (def equivalence ..equivalence)
   (def < ..<)))

(def .public enum
  (Enum Rev)
  (implementation
   (def order ..order)
   (def succ ++)
   (def pred --)))

(def .public interval
  (Interval Rev)
  (implementation
   (def enum ..enum)
   (def top (.rev -1))
   (def bottom (.rev 0))))

(with_template [<name> <composite> <identity>]
  [(def .public <name>
     (Monoid Rev)
     (implementation
      (def identity (at interval <identity>))
      (def composite <composite>)))]

  [addition ..+   bottom]
  [maximum  ..max bottom]
  [minimum  ..min top]
  )

(def (decimals input)
  (-> Text Text)
  ("lux text clip" 1 (-- ("lux text size" input)) input))

(with_template [<struct> <codec> <char_bit_size> <error>]
  [(with_expansions [<failure> (these {try.#Failure ("lux text concat" <error> repr)})]
     (def .public <struct>
       (Codec Text Rev)
       (implementation
        (def (encoded value)
          (let [raw_output (at <codec> encoded (.nat value))
                max_num_chars (//nat.+ (//nat./ <char_bit_size> //i64.width)
                                       (case (//nat.% <char_bit_size> //i64.width)
                                         0 0
                                         _ 1))
                raw_size ("lux text size" raw_output)
                zero_padding (is Text
                                 (loop (again [zeroes_left (is Nat (//nat.- raw_size max_num_chars))
                                               output (is Text "")])
                                   (if (//nat.= 0 zeroes_left)
                                     output
                                     (again (-- zeroes_left)
                                            ("lux text concat" "0" output)))))]
            (|> raw_output
                ("lux text concat" zero_padding)
                ("lux text concat" "."))))

        (def (decoded repr)
          (let [repr_size ("lux text size" repr)]
            (if (//nat.> 1 repr_size)
              (case ("lux text char" 0 repr)
                (pattern (char "."))
                (case (at <codec> decoded (..decimals repr))
                  {try.#Success output}
                  {try.#Success (.rev output)}

                  failure
                  <failure>)
                
                else
                <failure>)
              <failure>))))))]

  [binary //nat.binary 1 "Invalid binary syntax: "]
  [octal  //nat.octal  3 "Invalid octal syntax: "]
  [hex    //nat.hex    4 "Invalid hexadecimal syntax: "]
  )

... 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 (digits _)
  (-> Any Digits)
  (array.empty //i64.width))

(def (digit idx digits)
  (-> Nat Digits Nat)
  (|> digits
      (array.item idx)
      (maybe.else 0)))

(def digits#put!
  (-> Nat Nat Digits Digits)
  array.has!)

(def (digits#times_5! idx output)
  (-> Nat Digits Digits)
  (loop (again [idx idx
                carry 0
                output output])
    (if (//int.< +0 (.int idx))
      output
      (let [raw (|> (..digit idx output)
                    (//nat.* 5)
                    (//nat.+ carry))]
        (again (-- idx)
               (//nat./ 10 raw)
               (digits#put! idx (//nat.% 10 raw) output))))))

(def (power_digits power)
  (-> Nat Digits)
  (loop (again [times power
                output (|> (..digits [])
                           (digits#put! power 1))])
    (if (//int.< +0 (.int times))
      output
      (again (-- times)
             (digits#times_5! power output)))))

(def (format digits)
  (-> Digits Text)
  (loop (again [idx (-- //i64.width)
                all_zeroes? true
                output ""])
    (if (//int.< +0 (.int idx))
      (if all_zeroes?
        "0"
        output)
      (let [digit (..digit idx digits)]
        (if (and (//nat.= 0 digit)
                 all_zeroes?)
          (again (-- idx) true output)
          (again (-- idx)
                 false
                 ("lux text concat"
                  (at //nat.decimal encoded digit)
                  output)))))))

(def (digits#+! param subject)
  (-> Digits Digits Digits)
  (loop (again [idx (-- //i64.width)
                carry 0
                output (..digits [])])
    (if (//int.< +0 (.int idx))
      output
      (let [raw (all //nat.+
                     carry
                     (..digit idx param)
                     (..digit idx subject))]
        (again (-- idx)
               (//nat./ 10 raw)
               (digits#put! idx (//nat.% 10 raw) output))))))

(def (text_digits input)
  (-> Text (Maybe Digits))
  (let [length ("lux text size" input)]
    (if (//nat.> //i64.width length)
      {.#None}
      (loop (again [idx 0
                    output (..digits [])])
        (if (//nat.< length idx)
          (case ("lux text index" 0 ("lux text clip" idx 1 input) "0123456789")
            {.#None}
            {.#None}

            {.#Some digit}
            (again (++ idx)
                   (digits#put! idx digit output)))
          {.#Some output})))))

(def (digits#< param subject)
  (-> Digits Digits Bit)
  (loop (again [idx 0])
    (and (//nat.< //i64.width idx)
         (let [pd (..digit idx param)
               sd (..digit idx subject)]
           (if (//nat.= pd sd)
             (again (++ idx))
             (//nat.< pd sd))))))

(def (digits#-!' idx param subject)
  (-> Nat Nat Digits Digits)
  (let [sd (..digit idx subject)]
    (if (//nat.< param sd)
      (let [diff (|> sd
                     (//nat.+ 10)
                     (//nat.- param))]
        (|> subject
            (digits#put! idx diff)
            (digits#-!' (-- idx) 1)))
      (digits#put! idx (//nat.- param sd) subject))))

(def (digits#-! param subject)
  (-> Digits Digits Digits)
  (loop (again [idx (-- //i64.width)
                output subject])
    (if (//int.< +0 (.int idx))
      output
      (again (-- idx)
             (digits#-!' idx (..digit idx param) output)))))

(def .public decimal
  (Codec Text Rev)
  (implementation
   (def (encoded input)
     (case (.nat input)
       0
       ".0"

       input
       (let [last_idx (-- //i64.width)]
         (loop (again [idx last_idx
                       digits (..digits [])])
           (if (//int.< +0 (.int idx))
             ("lux text concat" "." (..format digits))
             (if (//i64.one? idx input)
               (let [digits' (digits#+! (power_digits (//nat.- idx last_idx))
                                        digits)]
                 (again (-- idx)
                        digits'))
               (again (-- idx)
                      digits)))))))

   (def (decoded input)
     (let [dotted? (case ("lux text index" 0 "." input)
                     {.#Some 0}
                     true

                     _
                     false)
           within_limits? (|> input
                              "lux text size"
                              (//nat.<= (++ //i64.width)))]
       (if (and dotted? within_limits?)
         (case (|> input ..decimals ..text_digits)
           {.#Some digits}
           (loop (again [digits digits
                         idx 0
                         output 0])
             (if (//nat.< //i64.width idx)
               (let [power (power_digits idx)]
                 (if (digits#< power digits)
                   ... Skip power
                   (again digits (++ idx) output)
                   (again (digits#-! power digits)
                          (++ idx)
                          (//i64.one (//nat.- idx (-- //i64.width)) output))))
               {try.#Success (.rev output)}))

           {.#None}
           {try.#Failure ("lux text concat" "Wrong syntax for Rev: " input)})
         {try.#Failure ("lux text concat" "Wrong syntax for Rev: " input)}))
     )))