diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/data/number.lux | 218 |
1 files changed, 109 insertions, 109 deletions
diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index de8ba5242..388fa6174 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -1,4 +1,4 @@ -(;module: {#;doc "Implementations of common structures for Lux's primitive number types."} +(.module: {#.doc "Implementations of common structures for Lux's primitive number types."} lux (lux (control number [monoid #+ Monoid] @@ -24,7 +24,7 @@ ) (do-template [<type> <eq> <lt> <lte> <gt> <gte>] - [(struct: #export _ (order;Order <type>) + [(struct: #export _ (order.Order <type>) (def: eq <eq>) (def: < <lt>) (def: <= <lte>) @@ -134,7 +134,7 @@ (do-template [<name> <const> <doc>] [(def: #export <name> - {#;doc <doc>} + {#.doc <doc>} Frac (<const>))] @@ -144,7 +144,7 @@ ) (def: #export (not-a-number? number) - {#;doc "Tests whether a frac is actually not-a-number."} + {#.doc "Tests whether a frac is actually not-a-number."} (-> Frac Bool) (not (f/= number number))) @@ -161,11 +161,11 @@ (def: (decode input) (case (<decoder> [input]) - (#;Some value) - (#e;Success value) + (#.Some value) + (#e.Success value) - #;None - (#e;Error <error>))))] + #.None + (#e.Error <error>))))] [Frac "lux frac encode" "lux frac decode" "Could not decode Frac"] ) @@ -180,7 +180,7 @@ (def: (encode value) (loop [input value output ""] - (let [digit (maybe;assume (get-char <char-set> (n/% <base> input))) + (let [digit (maybe.assume (get-char <char-set> (n/% <base> input))) output' ("lux text concat" digit output) input' (n// <base> input)] (if (n/= +0 input') @@ -191,24 +191,24 @@ (let [input-size ("lux text size" repr)] (if (n/>= +2 input-size) (case ("lux text char" repr +0) - (^ (#;Some (char "+"))) + (^ (#.Some (char "+"))) (let [input ("lux text upper" repr)] (loop [idx +1 output +0] (if (n/< input-size idx) - (let [digit (maybe;assume (get-char input idx))] + (let [digit (maybe.assume (get-char input idx))] (case ("lux text index" <char-set> digit +0) - #;None - (#e;Error ("lux text concat" <error> repr)) + #.None + (#e.Error ("lux text concat" <error> repr)) - (#;Some index) + (#.Some index) (recur (n/inc idx) (|> output (n/* <base>) (n/+ index))))) - (#e;Success output)))) + (#e.Success output)))) _ - (#e;Error ("lux text concat" <error> repr))) - (#e;Error ("lux text concat" <error> repr))))))] + (#e.Error ("lux text concat" <error> repr))) + (#e.Error ("lux text concat" <error> repr))))))] [Binary@Codec<Text,Nat> +2 "01" "Invalid binary syntax for Nat: "] [Octal@Codec<Text,Nat> +8 "01234567" "Invalid octal syntax for Nat: "] @@ -227,10 +227,10 @@ (loop [input (|> value (i// <base>) (:: Number<Int> abs)) output (|> value (i/% <base>) (:: Number<Int> abs) int-to-nat (get-char <char-set>) - maybe;assume)] + maybe.assume)] (if (i/= 0 input) ("lux text concat" sign output) - (let [digit (maybe;assume (get-char <char-set> (int-to-nat (i/% <base> input))))] + (let [digit (maybe.assume (get-char <char-set> (int-to-nat (i/% <base> input))))] (recur (i// <base> input) ("lux text concat" digit output)))))))) @@ -238,7 +238,7 @@ (let [input-size ("lux text size" repr)] (if (n/>= +1 input-size) (let [sign (case (get-char repr +0) - (^ (#;Some "-")) + (^ (#.Some "-")) -1 _ @@ -247,16 +247,16 @@ (loop [idx (if (i/= -1 sign) +1 +0) output 0] (if (n/< input-size idx) - (let [digit (maybe;assume (get-char input idx))] + (let [digit (maybe.assume (get-char input idx))] (case ("lux text index" <char-set> digit +0) - #;None - (#e;Error <error>) + #.None + (#e.Error <error>) - (#;Some index) + (#.Some index) (recur (n/inc idx) (|> output (i/* <base>) (i/+ (:! Int index)))))) - (#e;Success (i/* sign output))))) - (#e;Error <error>)))))] + (#e.Success (i/* sign output))))) + (#e.Error <error>)))))] [Binary@Codec<Text,Int> 2 "01" "Invalid binary syntax for Int: "] [Octal@Codec<Text,Int> 8 "01234567" "Invalid octal syntax for Int: "] @@ -266,7 +266,7 @@ (def: (de-prefix input) (-> Text Text) - (maybe;assume ("lux text clip" input +1 ("lux text size" input)))) + (maybe.assume ("lux text clip" input +1 ("lux text size" input)))) (do-template [<struct> <nat> <char-bit-size> <error>] [(struct: #export <struct> (Codec Text Deg) @@ -287,14 +287,14 @@ (let [repr-size ("lux text size" repr)] (if (n/>= +2 repr-size) (case ("lux text char" repr +0) - (^multi (^ (#;Some (char "."))) + (^multi (^ (#.Some (char "."))) [(:: <nat> decode ("lux text concat" "+" (de-prefix repr))) - (#e;Success output)]) - (#e;Success (:! Deg output)) + (#e.Success output)]) + (#e.Success (:! Deg output)) _ - (#e;Error ("lux text concat" <error> repr))) - (#e;Error ("lux text concat" <error> repr))))))] + (#e.Error ("lux text concat" <error> repr))) + (#e.Error ("lux text concat" <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: "] @@ -315,19 +315,19 @@ ("lux text concat" "." output) (let [shifted (f/* <base> dec-left) digit (|> shifted (f/% <base>) frac-to-int int-to-nat - (get-char <char-set>) maybe;assume)] + (get-char <char-set>) maybe.assume)] (recur (f/% 1.0 shifted) ("lux text concat" output digit))))))] ("lux text concat" whole-part decimal-part))) (def: (decode repr) (case ("lux text index" repr "." +0) - (#;Some split-index) - (let [whole-part (maybe;assume ("lux text clip" repr +0 split-index)) - decimal-part (maybe;assume ("lux text clip" repr (n/inc split-index) ("lux text size" repr)))] + (#.Some split-index) + (let [whole-part (maybe.assume ("lux text clip" repr +0 split-index)) + decimal-part (maybe.assume ("lux text clip" repr (n/inc split-index) ("lux text size" repr)))] (case [(:: <int> decode whole-part) (:: <int> decode decimal-part)] - (^multi [(#e;Success whole) (#e;Success decimal)] + (^multi [(#e.Success whole) (#e.Success decimal)] (i/>= 0 decimal)) (let [sign (if (i/< 0 whole) -1.0 @@ -340,19 +340,19 @@ (f/* <base> output)))) adjusted-decimal (|> decimal int-to-frac (f// div-power)) dec-deg (case (:: Hex@Codec<Text,Deg> decode ("lux text concat" "." decimal-part)) - (#e;Success dec-deg) + (#e.Success dec-deg) dec-deg - (#e;Error error) + (#e.Error error) (error! error))] - (#e;Success (f/+ (int-to-frac whole) + (#e.Success (f/+ (int-to-frac whole) (f/* sign adjusted-decimal)))) _ - (#e;Error ("lux text concat" <error> repr)))) + (#e.Error ("lux text concat" <error> repr)))) _ - (#e;Error ("lux text concat" <error> repr)))))] + (#e.Error ("lux text concat" <error> repr)))))] [Binary@Codec<Text,Frac> Binary@Codec<Text,Int> 2.0 "01" "Invalid binary syntax: "] ) @@ -368,8 +368,8 @@ (if (n/<= chunk-size num-digits) (list digits) (let [boundary (n/- chunk-size num-digits) - chunk (maybe;assume ("lux text clip" digits boundary num-digits)) - remaining (maybe;assume ("lux text clip" digits +0 boundary))] + chunk (maybe.assume ("lux text clip" digits boundary num-digits)) + remaining (maybe.assume ("lux text clip" digits +0 boundary))] (list& chunk (segment-digits chunk-size remaining))))))) (def: (bin-segment-to-hex input) @@ -443,19 +443,19 @@ (def: (map f xs) (All [a b] (-> (-> a b) (List a) (List b))) (case xs - #;Nil - #;Nil + #.Nil + #.Nil - (#;Cons x xs') - (#;Cons (f x) (map f xs')))) + (#.Cons x xs') + (#.Cons (f x) (map f xs')))) (def: (re-join-chunks xs) (-> (List Text) Text) (case xs - #;Nil + #.Nil "" - (#;Cons x xs') + (#.Cons x xs') ("lux text concat" x (re-join-chunks xs')))) (do-template [<from> <from-translator> <to> <to-translator> <base-bits>] @@ -497,11 +497,11 @@ (def: (encode value) (let [sign (:: Number<Frac> signum value) raw-bin (:: Binary@Codec<Text,Frac> encode value) - dot-idx (maybe;assume ("lux text index" raw-bin "." +0)) - whole-part (maybe;assume ("lux text clip" raw-bin + dot-idx (maybe.assume ("lux text index" raw-bin "." +0)) + whole-part (maybe.assume ("lux text clip" raw-bin (if (f/= -1.0 sign) +1 +0) dot-idx)) - decimal-part (maybe;assume ("lux text clip" raw-bin (n/inc dot-idx) ("lux text size" raw-bin))) + decimal-part (maybe.assume ("lux text clip" raw-bin (n/inc dot-idx) ("lux text size" raw-bin))) hex-output (|> (<from> false decimal-part) ("lux text concat" ".") ("lux text concat" (<from> true whole-part)) @@ -510,28 +510,28 @@ (def: (decode repr) (let [sign (case ("lux text index" repr "-" +0) - (#;Some +0) + (#.Some +0) -1.0 _ 1.0)] (case ("lux text index" repr "." +0) - (#;Some split-index) - (let [whole-part (maybe;assume ("lux text clip" repr (if (f/= -1.0 sign) +1 +0) split-index)) - decimal-part (maybe;assume ("lux text clip" repr (n/inc split-index) ("lux text size" repr))) + (#.Some split-index) + (let [whole-part (maybe.assume ("lux text clip" repr (if (f/= -1.0 sign) +1 +0) split-index)) + decimal-part (maybe.assume ("lux text clip" repr (n/inc split-index) ("lux text size" repr))) as-binary (|> (<to> decimal-part) ("lux text concat" ".") ("lux text concat" (<to> whole-part)) ("lux text concat" (if (f/= -1.0 sign) "-" "")))] (case (:: Binary@Codec<Text,Frac> decode as-binary) - (#e;Error _) - (#e;Error ("lux text concat" <error> repr)) + (#e.Error _) + (#e.Error ("lux text concat" <error> repr)) output output)) _ - (#e;Error ("lux text concat" <error> repr))))))] + (#e.Error ("lux text concat" <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] @@ -539,30 +539,30 @@ (do-template [<macro> <nat> <int> <deg> <frac> <error> <doc>] [(macro: #export (<macro> tokens state) - {#;doc <doc>} + {#.doc <doc>} (case tokens - (#;Cons [meta (#;Text repr)] #;Nil) + (#.Cons [meta (#.Text repr)] #.Nil) (case (:: <nat> decode repr) - (#e;Success value) - (#e;Success [state (list [meta (#;Nat value)])]) + (#e.Success value) + (#e.Success [state (list [meta (#.Nat value)])]) - (^multi (#e;Error _) - [(:: <int> decode repr) (#e;Success value)]) - (#e;Success [state (list [meta (#;Int value)])]) + (^multi (#e.Error _) + [(:: <int> decode repr) (#e.Success value)]) + (#e.Success [state (list [meta (#.Int value)])]) - (^multi (#e;Error _) - [(:: <deg> decode repr) (#e;Success value)]) - (#e;Success [state (list [meta (#;Deg value)])]) + (^multi (#e.Error _) + [(:: <deg> decode repr) (#e.Success value)]) + (#e.Success [state (list [meta (#.Deg value)])]) - (^multi (#e;Error _) - [(:: <frac> decode repr) (#e;Success value)]) - (#e;Success [state (list [meta (#;Frac value)])]) + (^multi (#e.Error _) + [(:: <frac> decode repr) (#e.Success value)]) + (#e.Success [state (list [meta (#.Frac value)])]) _ - (#e;Error <error>)) + (#e.Error <error>)) _ - (#e;Error <error>)))] + (#e.Error <error>)))] [bin Binary@Codec<Text,Nat> Binary@Codec<Text,Int> Binary@Codec<Text,Deg> Binary@Codec<Text,Frac> "Invalid binary syntax." @@ -592,11 +592,11 @@ (def: (make-digits _) (-> Top Digits) - ("lux array new" bit;width)) + ("lux array new" bit.width)) (def: (digits-get idx digits) (-> Nat Digits Nat) - (maybe;default +0 ("lux array get" digits idx))) + (maybe.default +0 ("lux array get" digits idx))) (def: (digits-put idx digit digits) (-> Nat Nat Digits Digits) @@ -632,7 +632,7 @@ (def: (digits-to-text digits) (-> Digits Text) - (loop [idx (n/dec bit;width) + (loop [idx (n/dec bit.width) all-zeroes? true output ""] (if (i/>= 0 (:! Int idx)) @@ -651,7 +651,7 @@ (def: (digits-add param subject) (-> Digits Digits Digits) - (loop [idx (n/dec bit;width) + (loop [idx (n/dec bit.width) carry +0 output (make-digits [])] (if (i/>= 0 (:! Int idx)) @@ -667,25 +667,25 @@ (def: (text-to-digits input) (-> Text (Maybe Digits)) (let [length ("lux text size" input)] - (if (n/<= bit;width length) + (if (n/<= bit.width length) (loop [idx +0 output (make-digits [])] (if (n/< length idx) - (let [char (maybe;assume (get-char input idx))] + (let [char (maybe.assume (get-char input idx))] (case ("lux text index" "0123456789" char +0) - #;None - #;None + #.None + #.None - (#;Some digit) + (#.Some digit) (recur (n/inc idx) (digits-put idx digit output)))) - (#;Some output))) - #;None))) + (#.Some output))) + #.None))) (def: (digits-lt param subject) (-> Digits Digits Bool) (loop [idx +0] - (and (n/< bit;width idx) + (and (n/< bit.width idx) (let [pd (digits-get idx param) sd (digits-get idx subject)] (if (n/= pd sd) @@ -706,7 +706,7 @@ (def: (digits-sub! param subject) (-> Digits Digits Digits) - (loop [idx (n/dec bit;width) + (loop [idx (n/dec bit.width) output subject] (if (i/>= 0 (nat-to-int idx)) (recur (n/dec idx) @@ -716,13 +716,13 @@ (struct: #export _ (Codec Text Deg) (def: (encode input) (let [input (:! Nat input) - last-idx (n/dec bit;width)] + 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) + (if (bit.set? idx input) (let [digits' (digits-add (digits-power (n/- idx last-idx)) digits)] (recur (n/dec idx) @@ -735,33 +735,33 @@ (def: (decode input) (let [length ("lux text size" input) dotted? (case ("lux text index" input "." +0) - (#;Some +0) + (#.Some +0) true _ false)] (if (and dotted? - (n/<= (n/inc bit;width) length)) + (n/<= (n/inc bit.width) length)) (case (|> ("lux text clip" input +1 length) - maybe;assume + maybe.assume text-to-digits) - (#;Some digits) + (#.Some digits) (loop [digits digits idx +0 output +0] - (if (n/< bit;width idx) + (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)))) - (#e;Success (:! Deg output)))) + (bit.set (n/- idx (n/dec bit.width)) output)))) + (#e.Success (:! Deg output)))) - #;None - (#e;Error ("lux text concat" "Wrong syntax for Deg: " input))) - (#e;Error ("lux text concat" "Wrong syntax for Deg: " input)))) + #.None + (#e.Error ("lux text concat" "Wrong syntax for Deg: " input))) + (#e.Error ("lux text concat" "Wrong syntax for Deg: " input)))) )) (def: (log2 input) @@ -797,26 +797,26 @@ (let [sign (:: Number<Frac> signum input) input (:: Number<Frac> abs input) exponent ("lux math floor" (log2 input)) - exponent-mask (|> +1 (bit;shift-left exponent-size) n/dec) + exponent-mask (|> +1 (bit.shift-left exponent-size) n/dec) mantissa (|> input ## Normalize (f// ("lux math pow" 2.0 exponent)) ## Make it int-equivalent (f/* ("lux 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)) + 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))) + ($_ 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: <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>)))] + (|> input (bit.and <mask>) (bit.shift-right <offset>)))] [mantissa mantissa-mask mantissa-size +0] [exponent exponent-mask exponent-size mantissa-size] @@ -841,7 +841,7 @@ (f/* -1.0 0.0)) ## else - (let [normalized (|> M (bit;set mantissa-size) + (let [normalized (|> M (bit.set mantissa-size) nat-to-int int-to-frac (f// ("lux math pow" 2.0 52.0))) power (|> E (n/- double-bias) |