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

(.module:
  [library
   [lux "*"
    [abstract
     [hash {"+" [Hash]}]
     [enum {"+" [Enum]}]
     [interval {"+" [Interval]}]
     [monoid {"+" [Monoid]}]
     [equivalence {"+" [Equivalence]}]
     [codec {"+" [Codec]}]
     ["[0]" order {"+" [Order]}]]
    [control
     ["[0]" function]
     ["[0]" maybe]
     ["[0]" try {"+" [Try]}]]]])

(template [<extension> <output> <name>]
  [(def: .public (<name> parameter subject)
     (-> Nat Nat <output>)
     (<extension> parameter subject))]

  ["lux i64 =" Bit =]
  ["lux i64 +" Nat +]
  ["lux i64 -" Nat -]
  )

(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 (< reference sample)
  (-> Nat Nat Bit)
  (let [referenceH (..high reference)
        sampleH (..high sample)]
    (if ("lux i64 <" referenceH sampleH)
      #1
      (if ("lux i64 =" referenceH sampleH)
        ("lux i64 <"
         (..low reference)
         (..low sample))
        #0))))

(def: .public (<= reference sample)
  (-> Nat Nat Bit)
  (if (..< reference sample)
    #1
    ("lux i64 =" reference sample)))

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

(def: .public (>= reference sample)
  (-> Nat Nat Bit)
  (if (..< sample reference)
    #1
    ("lux i64 =" reference sample)))

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

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

(def: .public (* parameter subject)
  (-> Nat Nat Nat)
  (:as Nat
       ("lux i64 *"
        (:as Int parameter)
        (:as Int subject))))

(def: .public (/ parameter subject)
  (-> Nat Nat Nat)
  (if ("lux i64 <" +0 (:as Int parameter))
    (if (..< parameter subject)
      0
      1)
    (let [quotient (|> subject
                       ("lux i64 right-shift" 1)
                       ("lux i64 /" (:as Int parameter))
                       ("lux i64 left-shift" 1))
          flat ("lux i64 *"
                (:as Int parameter)
                (:as Int quotient))
          remainder ("lux i64 -" flat subject)]
      (if (..< parameter remainder)
        quotient
        ("lux i64 +" 1 quotient)))))

(def: .public (/% parameter subject)
  (-> Nat Nat [Nat Nat])
  (let [quotient (../ parameter subject)
        flat ("lux i64 *"
              (:as Int parameter)
              (:as Int quotient))]
    [quotient ("lux i64 -" flat subject)]))

(def: .public (% parameter subject)
  (-> Nat Nat Nat)
  (let [flat ("lux i64 *"
              (:as Int parameter)
              (:as Int (../ parameter subject)))]
    ("lux i64 -" flat subject)))

(def: .public (gcd a b)
  (-> Nat Nat Nat)
  (case b
    0 a
    _ (gcd b (..% b a))))

(def: .public (co_prime? a b)
  (-> Nat Nat Bit)
  (..= 1 (..gcd a b)))

(def: .public (lcm a b)
  (-> Nat Nat Nat)
  (case [a b]
    (^or [_ 0] [0 _])
    0

    _
    (|> a (../ (..gcd a b)) (..* b))))

(def: .public even?
  (-> Nat Bit)
  (|>> (..% 2) ("lux i64 =" 0)))

(def: .public odd?
  (-> Nat Bit)
  (|>> ..even? not))

(def: .public frac
  (-> Nat Frac)
  (|>> .int "lux i64 f64"))

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

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

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

(implementation: .public interval
  (Interval Nat)

  (def: &enum ..enum)
  (def: top (-- 0))
  (def: bottom 0))

(template [<name> <composite> <identity>]
  [(implementation: .public <name>
     (Monoid Nat)
     
     (def: identity <identity>)
     (def: composite <composite>))]

  [addition       ..+   0]
  [multiplication ..*   1]
  [minimum        ..min (\ ..interval top)]
  [maximum        ..max (\ ..interval bottom)]
  )

(def: (binary_character value)
  (-> Nat Text)
  (case value
    0 "0"
    1 "1"
    _ (undefined)))

(def: (binary_value digit)
  (-> Nat (Maybe Nat))
  (case digit
    (^ (char "0")) (#.Some 0)
    (^ (char "1")) (#.Some 1)
    _ #.None))

(def: (octal_character value)
  (-> Nat Text)
  (case value
    0 "0"
    1 "1"
    2 "2"
    3 "3"
    4 "4"
    5 "5"
    6 "6"
    7 "7"
    _ (undefined)))

(def: (octal_value digit)
  (-> Nat (Maybe Nat))
  (case digit
    (^ (char "0")) (#.Some 0)
    (^ (char "1")) (#.Some 1)
    (^ (char "2")) (#.Some 2)
    (^ (char "3")) (#.Some 3)
    (^ (char "4")) (#.Some 4)
    (^ (char "5")) (#.Some 5)
    (^ (char "6")) (#.Some 6)
    (^ (char "7")) (#.Some 7)
    _ #.None))

(def: (decimal_character value)
  (-> Nat Text)
  (case value
    0 "0"
    1 "1"
    2 "2"
    3 "3"
    4 "4"
    5 "5"
    6 "6"
    7 "7"
    8 "8"
    9 "9"
    _ (undefined)))

(def: (decimal_value digit)
  (-> Nat (Maybe Nat))
  (case digit
    (^ (char "0")) (#.Some 0)
    (^ (char "1")) (#.Some 1)
    (^ (char "2")) (#.Some 2)
    (^ (char "3")) (#.Some 3)
    (^ (char "4")) (#.Some 4)
    (^ (char "5")) (#.Some 5)
    (^ (char "6")) (#.Some 6)
    (^ (char "7")) (#.Some 7)
    (^ (char "8")) (#.Some 8)
    (^ (char "9")) (#.Some 9)
    _ #.None))

(def: (hexadecimal_character value)
  (-> Nat Text)
  (case value
    0 "0"
    1 "1"
    2 "2"
    3 "3"
    4 "4"
    5 "5"
    6 "6"
    7 "7"
    8 "8"
    9 "9"
    10 "A"
    11 "B"
    12 "C"
    13 "D"
    14 "E"
    15 "F"
    _ (undefined)))

(def: (hexadecimal_value digit)
  (-> Nat (Maybe Nat))
  (case digit
    (^template [<character> <number>]
      [(^ (char <character>)) (#.Some <number>)])
    (["0" 0] ["1" 1] ["2" 2] ["3" 3] ["4" 4]
     ["5" 5] ["6" 6] ["7" 7] ["8" 8] ["9" 9])

    (^template [<lower> <upper> <number>]
      [(^or (^ (char <lower>)) (^ (char <upper>))) (#.Some <number>)])
    (["a" "A" 10] ["b" "B" 11] ["c" "C" 12]
     ["d" "D" 13] ["e" "E" 14] ["f" "F" 15])
    _ #.None))

(template [<shift> <struct> <to_character> <to_value> <error>]
  [(implementation: .public <struct>
     (Codec Text Nat)
     
     (def: encoded
       (let [mask (|> 1 ("lux i64 left-shift" <shift>) --)]
         (function (_ value)
           (loop [input value
                  output ""]
             (let [output' ("lux text concat"
                            (<to_character> ("lux i64 and" mask input))
                            output)]
               (case (: Nat ("lux i64 right-shift" <shift> input))
                 0
                 output'

                 input'
                 (recur input' output')))))))

     (def: (decoded repr)
       (let [input_size ("lux text size" repr)]
         (if (..> 0 input_size)
           (loop [idx 0
                  output 0]
             (if (..< input_size idx)
               (case (<to_value> ("lux text char" idx repr))
                 (#.Some digit_value)
                 (recur (++ idx)
                        (|> output
                            ("lux i64 left-shift" <shift>)
                            ("lux i64 or" digit_value)))

                 _
                 (#try.Failure ("lux text concat" <error> repr)))
               (#try.Success output)))
           (#try.Failure ("lux text concat" <error> repr))))))]

  [1 binary binary_character      binary_value      "Invalid binary syntax for Nat: "]
  [3 octal  octal_character       octal_value       "Invalid octal syntax for Nat: "]
  [4 hex    hexadecimal_character hexadecimal_value "Invalid hexadecimal syntax for Nat: "]
  )

(implementation: .public decimal
  (Codec Text Nat)
  
  (def: (encoded value)
    (loop [input value
           output ""]
      (let [digit (decimal_character (..% 10 input))
            output' ("lux text concat" digit output)]
        (case (../ 10 input)
          0
          output'

          input'
          (recur input' output')))))

  (def: (decoded repr)
    (let [input_size ("lux text size" repr)]
      (with_expansions [<failure> (#try.Failure ("lux text concat" "Invalid decimal syntax for Nat: " repr))]
        (if (..> 0 input_size)
          (loop [idx 0
                 output 0]
            (if (..< input_size idx)
              (case (decimal_value ("lux text char" idx repr))
                #.None
                <failure>

                (#.Some digit_value)
                (recur (++ idx)
                       (|> output (..* 10) (..+ digit_value))))
              (#try.Success output)))
          <failure>)))))

(implementation: .public hash
  (Hash Nat)
  
  (def: &equivalence ..equivalence)
  (def: hash function.identity))