(.module:
  [library
   [lux "*"
    [abstract
     [hash {"+" [Hash]}]
     [enum {"+" [Enum]}]
     [interval {"+" [Interval]}]
     [monoid {"+" [Monoid]}]
     [equivalence {"+" [Equivalence]}]
     [codec {"+" [Codec]}]
     [order {"+" [Order]}]]
    [control
     ["[0]" maybe]
     ["[0]" try]]
    [data
     [collection
      ["[0]" array {"+" [Array]}]]]]]
  ["[0]" // "_"
   ["[1][0]" i64]
   ["[1][0]" nat]
   ["[1][0]" int]])

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

(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)
  (if (//nat.< (.nat reference) (.nat sample))
    true
    ("lux i64 =" reference sample)))

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

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

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

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

(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 (: 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 (: Nat ("lux i64 and" <least_significant_bit> param))
                         0 (..even_reciprocal (.nat param))
                         _ (..odd_reciprocal (.nat param)))]
        (.rev (//nat.* reciprocal (.nat subject)))))))

(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]
  )

(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)))

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

(implementation: .public hash
  (Hash Rev)
  
  (def: &equivalence ..equivalence)
  (def: hash .nat))

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

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

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

(template [<name> <composite> <identity>]
  [(implementation: .public <name>
     (Monoid Rev)
     
     (def: identity (\ 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))

(template [<struct> <codec> <char_bit_size> <error>]
  [(with_expansions [<error_output> (as_is (#try.Failure ("lux text concat" <error> repr)))]
     (implementation: .public <struct>
       (Codec Text Rev)
       
       (def: (encoded value)
         (let [raw_output (\ <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 (: Text
                               (loop [zeroes_left (: Nat (//nat.- raw_size max_num_chars))
                                      output (: Text "")]
                                 (if (//nat.= 0 zeroes_left)
                                   output
                                   (recur (-- 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)
               (^ (char "."))
               (case (\ <codec> decoded (..decimals repr))
                 (#try.Success output)
                 (#try.Success (.rev output))

                 _
                 <error_output>)
               
               _
               <error_output>)
             <error_output>)))))]

  [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.read! idx)
      (maybe.else 0)))

(def: digits\put!
  (-> Nat Nat Digits Digits)
  array.write!)

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

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

(def: (format digits)
  (-> Digits Text)
  (loop [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?)
          (recur (-- idx) true output)
          (recur (-- idx)
                 false
                 ("lux text concat"
                  (\ //nat.decimal encoded digit)
                  output)))))))

(def: (digits\+! param subject)
  (-> Digits Digits Digits)
  (loop [idx (-- //i64.width)
         carry 0
         output (..digits [])]
    (if (//int.< +0 (.int idx))
      output
      (let [raw ($_ //nat.+
                    carry
                    (..digit idx param)
                    (..digit idx subject))]
        (recur (-- 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 [idx 0
             output (..digits [])]
        (if (//nat.< length idx)
          (case ("lux text index" 0 ("lux text clip" idx 1 input) "0123456789")
            #.None
            #.None

            (#.Some digit)
            (recur (++ idx)
                   (digits\put! idx digit output)))
          (#.Some output))))))

(def: (digits\< param subject)
  (-> Digits Digits Bit)
  (loop [idx 0]
    (and (//nat.< //i64.width idx)
         (let [pd (..digit idx param)
               sd (..digit idx subject)]
           (if (//nat.= pd sd)
             (recur (++ 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 [idx (-- //i64.width)
         output subject]
    (if (//int.< +0 (.int idx))
      output
      (recur (-- idx)
             (digits\-!' idx (..digit idx param) output)))))

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

      input
      (let [last_idx (-- //i64.width)]
        (loop [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)]
                (recur (-- idx)
                       digits'))
              (recur (-- 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 [digits digits
                 idx 0
                 output 0]
            (if (//nat.< //i64.width idx)
              (let [power (power_digits idx)]
                (if (digits\< power digits)
                  ... Skip power
                  (recur digits (++ idx) output)
                  (recur (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))))
    ))