diff options
Diffstat (limited to 'stdlib/source/lux/data/number/nat.lux')
| -rw-r--r-- | stdlib/source/lux/data/number/nat.lux | 211 |
1 files changed, 211 insertions, 0 deletions
diff --git a/stdlib/source/lux/data/number/nat.lux b/stdlib/source/lux/data/number/nat.lux new file mode 100644 index 000000000..9e249b207 --- /dev/null +++ b/stdlib/source/lux/data/number/nat.lux @@ -0,0 +1,211 @@ +(.module: + [lux #* + [control + [hash (#+ Hash)] + [number (#+ Number)] + [enum (#+ Enum)] + [interval (#+ Interval)] + [monoid (#+ Monoid)] + [equivalence (#+ Equivalence)] + [codec (#+ Codec)] + ["." order (#+ Order)]] + [data + ["." error (#+ Error)] + ["." maybe] + ["." text (#+ Char)]] + ["." function]]) + +(structure: #export equivalence (Equivalence Nat) + (def: = n/=)) + +(structure: #export order (Order Nat) + (def: &equivalence ..equivalence) + (def: < n/<) + (def: <= n/<=) + (def: > n/>) + (def: >= n/>=)) + +(structure: #export enum (Enum Nat) + (def: &order ..order) + (def: succ inc) + (def: pred dec)) + +(structure: #export interval (Interval Nat) + (def: &enum ..enum) + (def: top (.nat -1)) + (def: bottom 0)) + +(structure: #export number (Number Nat) + (def: + n/+) + (def: - n/-) + (def: * n/*) + (def: / n//) + (def: % n/%) + (def: (negate value) (n/- (:: ..interval top) value)) + (def: abs function.identity) + (def: (signum x) + (case x + 0 0 + _ 1)) + ) + +(do-template [<name> <compose> <identity>] + [(structure: #export <name> (Monoid Nat) + (def: identity <identity>) + (def: compose <compose>))] + + [addition n/+ 0] + [multiplication n/* 1] + [maximum n/max (:: ..interval bottom)] + [minimum n/min (:: ..interval top)] + ) + +(def: #export (binary-character value) + (-> Nat (Maybe Text)) + (case value + 0 (#.Some "0") + 1 (#.Some "1") + _ #.None)) + +(def: #export (binary-value digit) + (-> Char (Maybe Nat)) + (case digit + (^ (char "0")) (#.Some 0) + (^ (char "1")) (#.Some 1) + _ #.None)) + +(def: #export (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: #export (octal-value digit) + (-> Char (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: #export (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: #export (decimal-value digit) + (-> Char (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: #export (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: #export (hexadecimal-value digit) + (-> Char (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) + (^or (^ (char "a")) (^ (char "A"))) (#.Some 10) + (^or (^ (char "b")) (^ (char "B"))) (#.Some 11) + (^or (^ (char "c")) (^ (char "C"))) (#.Some 12) + (^or (^ (char "d")) (^ (char "D"))) (#.Some 13) + (^or (^ (char "e")) (^ (char "E"))) (#.Some 14) + (^or (^ (char "f")) (^ (char "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') + output' + (recur input' output'))))) + + (def: (decode repr) + (let [input-size ("lux text size" repr)] + (if (n/> 0 input-size) + (loop [idx 0 + output 0] + (if (n/< input-size idx) + (case (<to-value> ("lux text char" repr idx)) + #.None + (#error.Failure ("lux text concat" <error> repr)) + + (#.Some digit-value) + (recur (inc idx) + (|> output (n/* <base>) (n/+ digit-value)))) + (#error.Success output))) + (#error.Failure ("lux text concat" <error> repr))))))] + + [binary 2 binary-character binary-value "Invalid binary syntax for Nat: "] + [octal 8 octal-character octal-value "Invalid octal syntax for Nat: "] + [decimal 10 decimal-character decimal-value "Invalid syntax for Nat: "] + [hex 16 hexadecimal-character hexadecimal-value "Invalid hexadecimal syntax for Nat: "] + ) + +(structure: #export hash (Hash Nat) + (def: &equivalence ..equivalence) + (def: hash function.identity)) |