aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/data
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/data/color.lux206
-rw-r--r--stdlib/source/lux/data/format/css/value.lux8
-rw-r--r--stdlib/source/lux/data/format/json.lux10
-rw-r--r--stdlib/source/lux/data/number/complex.lux173
-rw-r--r--stdlib/source/lux/data/number/frac.lux155
-rw-r--r--stdlib/source/lux/data/number/int.lux70
-rw-r--r--stdlib/source/lux/data/number/nat.lux54
-rw-r--r--stdlib/source/lux/data/number/rev.lux28
8 files changed, 421 insertions, 283 deletions
diff --git a/stdlib/source/lux/data/color.lux b/stdlib/source/lux/data/color.lux
index 60b87ab61..3a094b01c 100644
--- a/stdlib/source/lux/data/color.lux
+++ b/stdlib/source/lux/data/color.lux
@@ -4,7 +4,9 @@
[equivalence (#+ Equivalence)]]
[data
[number
- ["." rev ("#;." interval)]]
+ ["." int]
+ ["." rev ("#;." interval)]
+ ["f" frac]]
[collection
["." list ("#;." functor)]]]
["." math]
@@ -14,15 +16,15 @@
(def: rgb Nat 256)
(def: top Nat (dec rgb))
-(def: rgb-factor Frac (|> top .int int-to-frac))
+(def: rgb-factor Frac (|> top .int int.frac))
(def: scale-down
(-> Nat Frac)
- (|>> .int int-to-frac (f// rgb-factor)))
+ (|>> .int int.frac (f./ rgb-factor)))
(def: scale-up
(-> Frac Nat)
- (|>> (f/* rgb-factor) frac-to-int .nat))
+ (|>> (f.* rgb-factor) f.int .nat))
(type: #export RGB
{#red Nat
@@ -71,71 +73,71 @@
red (scale-down red)
green (scale-down green)
blue (scale-down blue)
- max ($_ f/max red green blue)
- min ($_ f/min red green blue)
- luminance (|> (f/+ max min) (f// +2.0))]
- (if (f/= max min)
+ max ($_ f.max red green blue)
+ min ($_ f.min red green blue)
+ luminance (|> (f.+ max min) (f./ +2.0))]
+ (if (f.= max min)
## Achromatic
[+0.0
+0.0
luminance]
## Chromatic
- (let [diff (|> max (f/- min))
+ (let [diff (|> max (f.- min))
saturation (|> diff
- (f// (if (f/> +0.5 luminance)
- (|> +2.0 (f/- max) (f/- min))
- (|> max (f/+ min)))))
- hue' (cond (f/= red max)
- (|> green (f/- blue) (f// diff)
- (f/+ (if (f/< blue green) +6.0 +0.0)))
+ (f./ (if (f.> +0.5 luminance)
+ (|> +2.0 (f.- max) (f.- min))
+ (|> max (f.+ min)))))
+ hue' (cond (f.= red max)
+ (|> green (f.- blue) (f./ diff)
+ (f.+ (if (f.< blue green) +6.0 +0.0)))
- (f/= green max)
- (|> blue (f/- red) (f// diff)
- (f/+ +2.0))
+ (f.= green max)
+ (|> blue (f.- red) (f./ diff)
+ (f.+ +2.0))
- ## (f/= blue max)
- (|> red (f/- green) (f// diff)
- (f/+ +4.0)))]
- [(|> hue' (f// +6.0))
+ ## (f.= blue max)
+ (|> red (f.- green) (f./ diff)
+ (f.+ +4.0)))]
+ [(|> hue' (f./ +6.0))
saturation
luminance]))))
(def: (hue-to-rgb p q t)
(-> Frac Frac Frac Frac)
- (let [t (cond (f/< +0.0 t) (f/+ +1.0 t)
- (f/> +1.0 t) (f/- +1.0 t)
+ (let [t (cond (f.< +0.0 t) (f.+ +1.0 t)
+ (f.> +1.0 t) (f.- +1.0 t)
## else
t)
- f2/3 (f// +3.0 +2.0)]
- (cond (f/< (f// +6.0 +1.0) t)
- (|> q (f/- p) (f/* +6.0) (f/* t) (f/+ p))
+ f2/3 (f./ +3.0 +2.0)]
+ (cond (f.< (f./ +6.0 +1.0) t)
+ (|> q (f.- p) (f.* +6.0) (f.* t) (f.+ p))
- (f/< (f// +2.0 +1.0) t)
+ (f.< (f./ +2.0 +1.0) t)
q
- (f/< f2/3 t)
- (|> q (f/- p) (f/* (|> f2/3 (f/- t))) (f/* +6.0) (f/+ p))
+ (f.< f2/3 t)
+ (|> q (f.- p) (f.* (|> f2/3 (f.- t))) (f.* +6.0) (f.+ p))
## else
p)))
(def: #export (from-hsl [hue saturation luminance])
(-> HSL Color)
- (if (f/= +0.0 saturation)
+ (if (f.= +0.0 saturation)
## Achromatic
(let [intensity (scale-up luminance)]
(from-rgb {#red intensity
#green intensity
#blue intensity}))
## Chromatic
- (let [q (if (f/< +0.5 luminance)
- (|> saturation (f/+ +1.0) (f/* luminance))
- (|> luminance (f/+ saturation) (f/- (f/* saturation luminance))))
- p (|> luminance (f/* +2.0) (f/- q))
- third (|> +1.0 (f// +3.0))]
- (from-rgb {#red (scale-up (|> hue (f/+ third) (hue-to-rgb p q)))
+ (let [q (if (f.< +0.5 luminance)
+ (|> saturation (f.+ +1.0) (f.* luminance))
+ (|> luminance (f.+ saturation) (f.- (f.* saturation luminance))))
+ p (|> luminance (f.* +2.0) (f.- q))
+ third (|> +1.0 (f./ +3.0))]
+ (from-rgb {#red (scale-up (|> hue (f.+ third) (hue-to-rgb p q)))
#green (scale-up (|> hue (hue-to-rgb p q)))
- #blue (scale-up (|> hue (f/- third) (hue-to-rgb p q)))}))))
+ #blue (scale-up (|> hue (f.- third) (hue-to-rgb p q)))}))))
(def: #export (to-hsb color)
(-> Color HSB)
@@ -143,42 +145,42 @@
red (scale-down red)
green (scale-down green)
blue (scale-down blue)
- max ($_ f/max red green blue)
- min ($_ f/min red green blue)
+ max ($_ f.max red green blue)
+ min ($_ f.min red green blue)
brightness max
- diff (|> max (f/- min))
- saturation (if (f/= +0.0 max)
+ diff (|> max (f.- min))
+ saturation (if (f.= +0.0 max)
+0.0
- (|> diff (f// max)))]
- (if (f/= max min)
+ (|> diff (f./ max)))]
+ (if (f.= max min)
## Achromatic
[+0.0 saturation brightness]
## Chromatic
- (let [hue (cond (f/= red max)
- (|> green (f/- blue) (f// diff)
- (f/+ (if (f/< blue green) +6.0 +0.0)))
-
- (f/= green max)
- (|> blue (f/- red) (f// diff)
- (f/+ +2.0))
-
- ## (f/= blue max)
- (|> red (f/- green) (f// diff)
- (f/+ +4.0)))]
- [(|> hue (f// +6.0))
+ (let [hue (cond (f.= red max)
+ (|> green (f.- blue) (f./ diff)
+ (f.+ (if (f.< blue green) +6.0 +0.0)))
+
+ (f.= green max)
+ (|> blue (f.- red) (f./ diff)
+ (f.+ +2.0))
+
+ ## (f.= blue max)
+ (|> red (f.- green) (f./ diff)
+ (f.+ +4.0)))]
+ [(|> hue (f./ +6.0))
saturation
brightness]))))
(def: #export (from-hsb [hue saturation brightness])
(-> HSB Color)
- (let [hue (|> hue (f/* +6.0))
+ (let [hue (|> hue (f.* +6.0))
i (math.floor hue)
- f (|> hue (f/- i))
- p (|> +1.0 (f/- saturation) (f/* brightness))
- q (|> +1.0 (f/- (f/* f saturation)) (f/* brightness))
- t (|> +1.0 (f/- (|> +1.0 (f/- f) (f/* saturation))) (f/* brightness))
+ f (|> hue (f.- i))
+ p (|> +1.0 (f.- saturation) (f.* brightness))
+ q (|> +1.0 (f.- (f.* f saturation)) (f.* brightness))
+ t (|> +1.0 (f.- (|> +1.0 (f.- f) (f.* saturation))) (f.* brightness))
v brightness
- mod (|> i (f/% +6.0) frac-to-int .nat)
+ mod (|> i (f.% +6.0) f.int .nat)
red (case mod 0 v 1 q 2 p 3 p 4 t 5 v _ (undefined))
green (case mod 0 t 1 v 2 v 3 q 4 p 5 p _ (undefined))
blue (case mod 0 p 1 p 2 t 3 v 4 v 5 q _ (undefined))]
@@ -192,13 +194,13 @@
red (scale-down red)
green (scale-down green)
blue (scale-down blue)
- key (|> +1.0 (f/- ($_ f/max red green blue)))
- f (if (f/< +1.0 key)
- (|> +1.0 (f// (|> +1.0 (f/- key))))
+ key (|> +1.0 (f.- ($_ f.max red green blue)))
+ f (if (f.< +1.0 key)
+ (|> +1.0 (f./ (|> +1.0 (f.- key))))
+0.0)
- cyan (|> +1.0 (f/- red) (f/- key) (f/* f))
- magenta (|> +1.0 (f/- green) (f/- key) (f/* f))
- yellow (|> +1.0 (f/- blue) (f/- key) (f/* f))]
+ cyan (|> +1.0 (f.- red) (f.- key) (f.* f))
+ magenta (|> +1.0 (f.- green) (f.- key) (f.* f))
+ yellow (|> +1.0 (f.- blue) (f.- key) (f.* f))]
{#cyan cyan
#magenta magenta
#yellow yellow
@@ -206,27 +208,27 @@
(def: #export (from-cmyk [cyan magenta yellow key])
(-> CMYK Color)
- (if (f/= +1.0 key)
+ (if (f.= +1.0 key)
(from-rgb {#red 0
#green 0
#blue 0})
- (let [red (|> (|> +1.0 (f/- cyan))
- (f/* (|> +1.0 (f/- key))))
- green (|> (|> +1.0 (f/- magenta))
- (f/* (|> +1.0 (f/- key))))
- blue (|> (|> +1.0 (f/- yellow))
- (f/* (|> +1.0 (f/- key))))]
+ (let [red (|> (|> +1.0 (f.- cyan))
+ (f.* (|> +1.0 (f.- key))))
+ green (|> (|> +1.0 (f.- magenta))
+ (f.* (|> +1.0 (f.- key))))
+ blue (|> (|> +1.0 (f.- yellow))
+ (f.* (|> +1.0 (f.- key))))]
(from-rgb {#red (scale-up red)
#green (scale-up green)
#blue (scale-up blue)}))))
(def: (normalize ratio)
(-> Frac Frac)
- (cond (f/> +1.0 ratio)
- (f/% +1.0 ratio)
+ (cond (f.> +1.0 ratio)
+ (f.% +1.0 ratio)
- (f/< +0.0 ratio)
- (|> +1.0 (f/+ (f/% +1.0 ratio)))
+ (f.< +0.0 ratio)
+ (|> +1.0 (f.+ (f.% +1.0 ratio)))
## else
ratio))
@@ -234,12 +236,12 @@
(def: #export (interpolate ratio end start)
(-> Frac Color Color Color)
(let [dS (normalize ratio)
- dE (|> +1.0 (f/- dS))
+ dE (|> +1.0 (f.- dS))
interpolate' (: (-> Nat Nat Nat)
(function (_ end start)
- (|> (|> start .int int-to-frac (f/* dS))
- (f/+ (|> end .int int-to-frac (f/* dE)))
- frac-to-int
+ (|> (|> start .int int.frac (f.* dS))
+ (f.+ (|> end .int int.frac (f.* dE)))
+ f.int
.nat)))
[redS greenS blueS] (to-rgb start)
[redE greenE blueE] (to-rgb end)]
@@ -277,12 +279,12 @@
(let [[hue saturation luminance] (to-hsl color)]
(from-hsl [hue
(|> saturation
- (f/* (|> +1.0 (<op> (normalize ratio))))
- (f/min +1.0))
+ (f.* (|> +1.0 (<op> (normalize ratio))))
+ (f.min +1.0))
luminance])))]
- [saturate f/+]
- [de-saturate f/-]
+ [saturate f.+]
+ [de-saturate f.-]
)
(def: #export (gray-scale color)
@@ -297,16 +299,16 @@
(-> Color [Color Color Color])
(let [[hue saturation luminance] (to-hsl color)]
[color
- (from-hsl [(|> hue (f/+ <1>) normalize)
+ (from-hsl [(|> hue (f.+ <1>) normalize)
saturation
luminance])
- (from-hsl [(|> hue (f/+ <2>) normalize)
+ (from-hsl [(|> hue (f.+ <2>) normalize)
saturation
luminance])]))]
- [triad (|> +1.0 (f// +3.0)) (|> +2.0 (f// +3.0))]
- [clash (|> +1.0 (f// +4.0)) (|> +3.0 (f// +4.0))]
- [split-complement (|> +1.0 (f// +5.0)) (|> +3.0 (f// +5.0))]
+ [triad (|> +1.0 (f./ +3.0)) (|> +2.0 (f./ +3.0))]
+ [clash (|> +1.0 (f./ +4.0)) (|> +3.0 (f./ +4.0))]
+ [split-complement (|> +1.0 (f./ +5.0)) (|> +3.0 (f./ +5.0))]
)
(template [<name> <1> <2> <3>]
@@ -314,18 +316,18 @@
(-> Color [Color Color Color Color])
(let [[hue saturation luminance] (to-hsl color)]
[color
- (from-hsl [(|> hue (f/+ <1>) normalize)
+ (from-hsl [(|> hue (f.+ <1>) normalize)
saturation
luminance])
- (from-hsl [(|> hue (f/+ <2>) normalize)
+ (from-hsl [(|> hue (f.+ <2>) normalize)
saturation
luminance])
- (from-hsl [(|> hue (f/+ <3>) normalize)
+ (from-hsl [(|> hue (f.+ <3>) normalize)
saturation
luminance])]))]
- [square (|> +1.0 (f// +4.0)) (|> +2.0 (f// +4.0)) (|> +3.0 (f// +4.0))]
- [tetradic (|> +2.0 (f// +12.0)) (|> +6.0 (f// +12.0)) (|> +8.0 (f// +12.0))]
+ [square (|> +1.0 (f./ +4.0)) (|> +2.0 (f./ +4.0)) (|> +3.0 (f./ +4.0))]
+ [tetradic (|> +2.0 (f./ +12.0)) (|> +6.0 (f./ +12.0)) (|> +8.0 (f./ +12.0))]
)
(def: #export (analogous results slice color)
@@ -335,7 +337,7 @@
(let [[hue saturation luminance] (to-hsl color)
slice (normalize slice)]
(list;map (function (_ idx)
- (from-hsl [(|> idx .int int-to-frac (f/* slice) (f/+ hue) normalize)
+ (from-hsl [(|> idx .int int.frac (f.* slice) (f.+ hue) normalize)
saturation
luminance]))
(list.indices results)))))
@@ -345,11 +347,11 @@
(if (n/= 0 results)
(list)
(let [[hue saturation brightness] (to-hsb color)
- slice (|> +1.0 (f// (|> results .int int-to-frac)))]
+ slice (|> +1.0 (f./ (|> results .int int.frac)))]
(|> (list.indices results)
- (list;map (|>> .int int-to-frac
- (f/* slice)
- (f/+ brightness)
+ (list;map (|>> .int int.frac
+ (f.* slice)
+ (f.+ brightness)
normalize
[hue saturation]
from-hsb))))))
diff --git a/stdlib/source/lux/data/format/css/value.lux b/stdlib/source/lux/data/format/css/value.lux
index 08889f2e4..2c77554c3 100644
--- a/stdlib/source/lux/data/format/css/value.lux
+++ b/stdlib/source/lux/data/format/css/value.lux
@@ -8,7 +8,9 @@
["." product]
["." maybe]
[number
- ["." rev]]
+ ["." nat]
+ ["." rev]
+ ["f" frac]]
["." text
["%" format (#+ Format format)]]
[collection
@@ -55,7 +57,7 @@
(def: (%number value)
(Format Frac)
(let [raw (%.frac value)]
- (if (f/< +0.0 value)
+ (if (f.< +0.0 value)
raw
(|> raw (text.split 1) maybe.assume product.right))))
@@ -1005,7 +1007,7 @@
(~~ (template.splice <function>+))))]
- [Nat (<| (:representation Value) ..px nat-to-frac)
+ [Nat (<| (:representation Value) ..px nat.frac)
[[blur "blur"]]]
[Nat (<| ..angle ..degree)
[[hue-rotate "hue-rotate"]]]
diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux
index 2c4d3ada1..d847d801b 100644
--- a/stdlib/source/lux/data/format/json.lux
+++ b/stdlib/source/lux/data/format/json.lux
@@ -16,7 +16,7 @@
["." maybe]
["." product]
[number
- ["." frac ("#@." decimal)]]
+ ["f" frac ("#@." decimal)]]
["." text ("#@." equivalence monoid)]
[collection
["." list ("#@." fold functor)]
@@ -157,7 +157,7 @@
[(<tag> x') (<tag> y')]
(:: <struct> = x' y'))
([#Boolean bit.equivalence]
- [#Number frac.equivalence]
+ [#Number f.equivalence]
[#String text.equivalence])
[(#Array xs) (#Array ys)]
@@ -202,8 +202,8 @@
(|>> (case>
+0.0 "0.0"
-0.0 "0.0"
- value (let [raw (:: frac.decimal encode value)]
- (if (f/< +0.0 value)
+ value (let [raw (:: f.decimal encode value)]
+ (if (f.< +0.0 value)
raw
(|> raw (text.split 1) maybe.assume product.right))))))
@@ -286,7 +286,7 @@
signed?' (l.this? "-")
offset (l.many l.decimal)]
(wrap ($_ text@compose mark (if signed?' "-" "") offset))))]
- (case (frac@decode ($_ text@compose (if signed? "-" "") digits "." decimals exp))
+ (case (f@decode ($_ text@compose (if signed? "-" "") digits "." decimals exp))
(#try.Failure message)
(p.fail message)
diff --git a/stdlib/source/lux/data/number/complex.lux b/stdlib/source/lux/data/number/complex.lux
index 8b9be426f..ec4b27326 100644
--- a/stdlib/source/lux/data/number/complex.lux
+++ b/stdlib/source/lux/data/number/complex.lux
@@ -11,7 +11,8 @@
[data
["." maybe]
[number
- ["." frac]]
+ ["." int]
+ ["f" frac]]
["." text ("#;." monoid)]
[collection
["." list ("#;." functor)]]]
@@ -39,14 +40,14 @@
(def: #export zero Complex (complex +0.0 +0.0))
(def: #export (not-a-number? complex)
- (or (frac.not-a-number? (get@ #real complex))
- (frac.not-a-number? (get@ #imaginary complex))))
+ (or (f.not-a-number? (get@ #real complex))
+ (f.not-a-number? (get@ #imaginary complex))))
(def: #export (= param input)
(-> Complex Complex Bit)
- (and (f/= (get@ #real param)
+ (and (f.= (get@ #real param)
(get@ #real input))
- (f/= (get@ #imaginary param)
+ (f.= (get@ #imaginary param)
(get@ #imaginary input))))
(template [<name> <op>]
@@ -57,8 +58,8 @@
#imaginary (<op> (get@ #imaginary param)
(get@ #imaginary input))})]
- [+ f/+]
- [- f/-]
+ [+ f.+]
+ [- f.-]
)
(structure: #export equivalence (Equivalence Complex)
@@ -70,51 +71,51 @@
(|>> (update@ #real <transform>)
(update@ #imaginary <transform>)))]
- [negate frac.negate]
- [signum frac.signum]
+ [negate f.negate]
+ [signum f.signum]
)
(def: #export conjugate
(-> Complex Complex)
- (update@ #imaginary frac.negate))
+ (update@ #imaginary f.negate))
(def: #export (*' param input)
(-> Frac Complex Complex)
- {#real (f/* param
+ {#real (f.* param
(get@ #real input))
- #imaginary (f/* param
+ #imaginary (f.* param
(get@ #imaginary input))})
(def: #export (* param input)
(-> Complex Complex Complex)
- {#real (f/- (f/* (get@ #imaginary param)
+ {#real (f.- (f.* (get@ #imaginary param)
(get@ #imaginary input))
- (f/* (get@ #real param)
+ (f.* (get@ #real param)
(get@ #real input)))
- #imaginary (f/+ (f/* (get@ #real param)
+ #imaginary (f.+ (f.* (get@ #real param)
(get@ #imaginary input))
- (f/* (get@ #imaginary param)
+ (f.* (get@ #imaginary param)
(get@ #real input)))})
(def: #export (/ param input)
(-> Complex Complex Complex)
(let [(^slots [#real #imaginary]) param]
- (if (f/< (frac.abs imaginary)
- (frac.abs real))
- (let [quot (f// imaginary real)
- denom (|> real (f/* quot) (f/+ imaginary))]
- {#real (|> (get@ #real input) (f/* quot) (f/+ (get@ #imaginary input)) (f// denom))
- #imaginary (|> (get@ #imaginary input) (f/* quot) (f/- (get@ #real input)) (f// denom))})
- (let [quot (f// real imaginary)
- denom (|> imaginary (f/* quot) (f/+ real))]
- {#real (|> (get@ #imaginary input) (f/* quot) (f/+ (get@ #real input)) (f// denom))
- #imaginary (|> (get@ #imaginary input) (f/- (f/* quot (get@ #real input))) (f// denom))}))))
+ (if (f.< (f.abs imaginary)
+ (f.abs real))
+ (let [quot (f./ imaginary real)
+ denom (|> real (f.* quot) (f.+ imaginary))]
+ {#real (|> (get@ #real input) (f.* quot) (f.+ (get@ #imaginary input)) (f./ denom))
+ #imaginary (|> (get@ #imaginary input) (f.* quot) (f.- (get@ #real input)) (f./ denom))})
+ (let [quot (f./ real imaginary)
+ denom (|> imaginary (f.* quot) (f.+ real))]
+ {#real (|> (get@ #imaginary input) (f.* quot) (f.+ (get@ #real input)) (f./ denom))
+ #imaginary (|> (get@ #imaginary input) (f.- (f.* quot (get@ #real input))) (f./ denom))}))))
(def: #export (/' param subject)
(-> Frac Complex Complex)
(let [(^slots [#real #imaginary]) subject]
- {#real (f// param real)
- #imaginary (f// param imaginary)}))
+ {#real (f./ param real)
+ #imaginary (f./ param imaginary)}))
(def: #export (% param input)
(-> Complex Complex Complex)
@@ -128,76 +129,76 @@
(def: #export (cos subject)
(-> Complex Complex)
(let [(^slots [#real #imaginary]) subject]
- {#real (f/* (math.cosh imaginary)
+ {#real (f.* (math.cosh imaginary)
(math.cos real))
- #imaginary (frac.negate (f/* (math.sinh imaginary)
- (math.sin real)))}))
+ #imaginary (f.negate (f.* (math.sinh imaginary)
+ (math.sin real)))}))
(def: #export (cosh subject)
(-> Complex Complex)
(let [(^slots [#real #imaginary]) subject]
- {#real (f/* (math.cos imaginary)
+ {#real (f.* (math.cos imaginary)
(math.cosh real))
- #imaginary (f/* (math.sin imaginary)
+ #imaginary (f.* (math.sin imaginary)
(math.sinh real))}))
(def: #export (sin subject)
(-> Complex Complex)
(let [(^slots [#real #imaginary]) subject]
- {#real (f/* (math.cosh imaginary)
+ {#real (f.* (math.cosh imaginary)
(math.sin real))
- #imaginary (f/* (math.sinh imaginary)
+ #imaginary (f.* (math.sinh imaginary)
(math.cos real))}))
(def: #export (sinh subject)
(-> Complex Complex)
(let [(^slots [#real #imaginary]) subject]
- {#real (f/* (math.cos imaginary)
+ {#real (f.* (math.cos imaginary)
(math.sinh real))
- #imaginary (f/* (math.sin imaginary)
+ #imaginary (f.* (math.sin imaginary)
(math.cosh real))}))
(def: #export (tan subject)
(-> Complex Complex)
(let [(^slots [#real #imaginary]) subject
- r2 (f/* +2.0 real)
- i2 (f/* +2.0 imaginary)
- d (f/+ (math.cos r2) (math.cosh i2))]
- {#real (f// d (math.sin r2))
- #imaginary (f// d (math.sinh i2))}))
+ r2 (f.* +2.0 real)
+ i2 (f.* +2.0 imaginary)
+ d (f.+ (math.cos r2) (math.cosh i2))]
+ {#real (f./ d (math.sin r2))
+ #imaginary (f./ d (math.sinh i2))}))
(def: #export (tanh subject)
(-> Complex Complex)
(let [(^slots [#real #imaginary]) subject
- r2 (f/* +2.0 real)
- i2 (f/* +2.0 imaginary)
- d (f/+ (math.cosh r2) (math.cos i2))]
- {#real (f// d (math.sinh r2))
- #imaginary (f// d (math.sin i2))}))
+ r2 (f.* +2.0 real)
+ i2 (f.* +2.0 imaginary)
+ d (f.+ (math.cosh r2) (math.cos i2))]
+ {#real (f./ d (math.sinh r2))
+ #imaginary (f./ d (math.sin i2))}))
(def: #export (abs subject)
(-> Complex Complex)
(let [(^slots [#real #imaginary]) subject]
- (complex (if (f/< (frac.abs imaginary)
- (frac.abs real))
- (if (f/= +0.0 imaginary)
- (frac.abs real)
- (let [q (f// imaginary real)]
- (f/* (math.pow +0.5 (f/+ +1.0 (f/* q q)))
- (frac.abs imaginary))))
- (if (f/= +0.0 real)
- (frac.abs imaginary)
- (let [q (f// real imaginary)]
- (f/* (math.pow +0.5 (f/+ +1.0 (f/* q q)))
- (frac.abs real))))
+ (complex (if (f.< (f.abs imaginary)
+ (f.abs real))
+ (if (f.= +0.0 imaginary)
+ (f.abs real)
+ (let [q (f./ imaginary real)]
+ (f.* (math.pow +0.5 (f.+ +1.0 (f.* q q)))
+ (f.abs imaginary))))
+ (if (f.= +0.0 real)
+ (f.abs imaginary)
+ (let [q (f./ real imaginary)]
+ (f.* (math.pow +0.5 (f.+ +1.0 (f.* q q)))
+ (f.abs real))))
))))
(def: #export (exp subject)
(-> Complex Complex)
(let [(^slots [#real #imaginary]) subject
r-exp (math.exp real)]
- {#real (f/* r-exp (math.cos imaginary))
- #imaginary (f/* r-exp (math.sin imaginary))}))
+ {#real (f.* r-exp (math.cos imaginary))
+ #imaginary (f.* r-exp (math.sin imaginary))}))
(def: #export (log subject)
(-> Complex Complex)
@@ -216,18 +217,18 @@
(def: (copy-sign sign magnitude)
(-> Frac Frac Frac)
- (f/* (frac.signum sign) magnitude))
+ (f.* (f.signum sign) magnitude))
(def: #export (root2 (^@ input (^slots [#real #imaginary])))
(-> Complex Complex)
- (let [t (|> input ..abs (get@ #real) (f/+ (frac.abs real)) (f// +2.0) (math.pow +0.5))]
- (if (f/>= +0.0 real)
+ (let [t (|> input ..abs (get@ #real) (f.+ (f.abs real)) (f./ +2.0) (math.pow +0.5))]
+ (if (f.>= +0.0 real)
{#real t
- #imaginary (f// (f/* +2.0 t)
+ #imaginary (f./ (f.* +2.0 t)
imaginary)}
- {#real (f// (f/* +2.0 t)
- (frac.abs imaginary))
- #imaginary (f/* t (copy-sign imaginary +1.0))})))
+ {#real (f./ (f.* +2.0 t)
+ (f.abs imaginary))
+ #imaginary (f.* t (copy-sign imaginary +1.0))})))
(def: #export (root2-1z input)
(-> Complex Complex)
@@ -235,18 +236,18 @@
(def: #export (reciprocal (^slots [#real #imaginary]))
(-> Complex Complex)
- (if (f/< (frac.abs imaginary)
- (frac.abs real))
- (let [q (f// imaginary real)
- scale (f// (|> real (f/* q) (f/+ imaginary))
+ (if (f.< (f.abs imaginary)
+ (f.abs real))
+ (let [q (f./ imaginary real)
+ scale (f./ (|> real (f.* q) (f.+ imaginary))
+1.0)]
- {#real (f/* q scale)
- #imaginary (frac.negate scale)})
- (let [q (f// real imaginary)
- scale (f// (|> imaginary (f/* q) (f/+ real))
+ {#real (f.* q scale)
+ #imaginary (f.negate scale)})
+ (let [q (f./ real imaginary)
+ scale (f./ (|> imaginary (f.* q) (f.+ real))
+1.0)]
{#real scale
- #imaginary (|> scale frac.negate (f/* q))})))
+ #imaginary (|> scale f.negate (f.* q))})))
(def: #export (acos input)
(-> Complex Complex)
@@ -279,18 +280,18 @@
(-> Nat Complex (List Complex))
(if (n/= 0 nth)
(list)
- (let [r-nth (|> nth .int int-to-frac)
- nth-root-of-abs (|> input abs (get@ #real) (math.pow (f// r-nth +1.0)))
- nth-phi (|> input argument (f// r-nth))
- slice (|> math.pi (f/* +2.0) (f// r-nth))]
+ (let [r-nth (|> nth .int int.frac)
+ nth-root-of-abs (|> input abs (get@ #real) (math.pow (f./ r-nth +1.0)))
+ nth-phi (|> input argument (f./ r-nth))
+ slice (|> math.pi (f.* +2.0) (f./ r-nth))]
(|> (list.indices nth)
(list;map (function (_ nth')
- (let [inner (|> nth' .int int-to-frac
- (f/* slice)
- (f/+ nth-phi))
- real (f/* nth-root-of-abs
+ (let [inner (|> nth' .int int.frac
+ (f.* slice)
+ (f.+ nth-phi))
+ real (f.* nth-root-of-abs
(math.cos inner))
- imaginary (f/* nth-root-of-abs
+ imaginary (f.* nth-root-of-abs
(math.sin inner))]
{#real real
#imaginary imaginary})))))))
diff --git a/stdlib/source/lux/data/number/frac.lux b/stdlib/source/lux/data/number/frac.lux
index ce7fb08bf..00e370d07 100644
--- a/stdlib/source/lux/data/number/frac.lux
+++ b/stdlib/source/lux/data/number/frac.lux
@@ -1,5 +1,5 @@
(.module:
- [lux #*
+ [lux (#- nat int rev)
[abstract
[hash (#+ Hash)]
[monoid (#+ Monoid)]
@@ -17,38 +17,105 @@
["#." int]
["#." rev]])
-(structure: #export equivalence (Equivalence Frac)
- (def: = f/=))
-
-(structure: #export order (Order Frac)
- (def: &equivalence ..equivalence)
- (def: < f/<))
-
-(def: #export + (-> Frac Frac Frac) f/+)
-
-(def: #export - (-> Frac Frac Frac) f/-)
-
-(def: #export * (-> Frac Frac Frac) f/*)
-
-(def: #export / (-> Frac Frac Frac) f//)
+(def: #export (= reference sample)
+ {#.doc "Frac(tion) equivalence."}
+ (-> Frac Frac Bit)
+ ("lux f64 =" reference sample))
+
+(def: #export (< reference sample)
+ {#.doc "Frac(tion) less-than."}
+ (-> Frac Frac Bit)
+ ("lux f64 <" reference sample))
+
+(def: #export (<= reference sample)
+ {#.doc "Frac(tion) less-than-equal."}
+ (-> Frac Frac Bit)
+ (or ("lux f64 <" reference sample)
+ ("lux f64 =" reference sample)))
+
+(def: #export (> reference sample)
+ {#.doc "Frac(tion) greater-than."}
+ (-> Frac Frac Bit)
+ ("lux f64 <" sample reference))
+
+(def: #export (>= reference sample)
+ {#.doc "Frac(tion) greater-than-equal."}
+ (-> Frac Frac Bit)
+ (or ("lux f64 <" sample reference)
+ ("lux f64 =" sample reference)))
+
+(template [<name> <op> <doc>]
+ [(def: #export (<name> param subject)
+ {#.doc <doc>}
+ (-> Frac Frac Frac)
+ (<op> param subject))]
+
+ [+ "lux f64 +" "Frac(tion) addition."]
+ [- "lux f64 -" "Frac(tion) substraction."]
+ [* "lux f64 *" "Frac(tion) multiplication."]
+ [/ "lux f64 /" "Frac(tion) division."]
+ [% "lux f64 %" "Frac(tion) remainder."]
+ )
-(def: #export % (-> Frac Frac Frac) f/%)
+(def: #export (/% param subject)
+ (-> Frac Frac [Frac Frac])
+ [(../ param subject)
+ (..% param subject)])
-(def: #export negate (-> Frac Frac) (f/* -1.0))
+(def: #export negate (-> Frac Frac) (..* -1.0))
(def: #export (abs x)
(-> Frac Frac)
- (if (f/< +0.0 x)
+ (if (..< +0.0 x)
(..* -1.0 x)
x))
(def: #export (signum x)
(-> Frac Frac)
- (cond (f/= +0.0 x) +0.0
- (f/< +0.0 x) -1.0
+ (cond (..= +0.0 x) +0.0
+ (..< +0.0 x) -1.0
## else
+1.0))
+(template [<name> <test> <doc>]
+ [(def: #export (<name> left right)
+ {#.doc <doc>}
+ (-> Frac Frac Frac)
+ (if (<test> right left)
+ left
+ right))]
+
+ [min ..< "Frac(tion) minimum."]
+ [max ..> "Frac(tion) minimum."]
+ )
+
+(def: #export nat
+ (-> Frac Nat)
+ (|>> "lux f64 i64" .nat))
+
+(def: #export int
+ (-> Frac Int)
+ (|>> "lux f64 i64"))
+
+(def: frac-denominator
+ (|> -1
+ ("lux i64 logical-right-shift" 11)
+ "lux i64 f64"))
+
+(def: #export rev
+ (-> Frac Rev)
+ (|>> ..abs
+ (..% +1.0)
+ (..* frac-denominator)
+ "lux f64 i64"
+ ("lux i64 left-shift" 11)))
+
+(structure: #export equivalence (Equivalence Frac)
+ (def: = ..=))
+
+(structure: #export order (Order Frac)
+ (def: &equivalence ..equivalence)
+ (def: < ..<))
(template [<name> <compose> <identity>]
[(structure: #export <name> (Monoid Frac)
@@ -57,8 +124,8 @@
[addition ..+ +0.0]
[multiplication ..* +1.0]
- [maximum f/max ("lux f64 min")]
- [minimum f/min ("lux f64 max")]
+ [maximum ..max ("lux f64 min")]
+ [minimum ..min ("lux f64 max")]
)
(template [<name> <numerator> <doc>]
@@ -75,17 +142,17 @@
(def: #export (not-a-number? number)
{#.doc "Tests whether a frac is actually not-a-number."}
(-> Frac Bit)
- (not (f/= number number)))
+ (not (..= number number)))
(def: #export (frac? value)
(-> Frac Bit)
(not (or (not-a-number? value)
- (f/= positive-infinity value)
- (f/= negative-infinity value))))
+ (..= positive-infinity value)
+ (..= negative-infinity value))))
(structure: #export decimal (Codec Text Frac)
(def: (encode x)
- (if (f/< +0.0 x)
+ (if (..< +0.0 x)
("lux f64 encode" x)
("lux text concat" "+" ("lux f64 encode" x))))
@@ -100,17 +167,17 @@
(template [<struct> <int> <base> <char-set> <error>]
[(structure: #export <struct> (Codec Text Frac)
(def: (encode value)
- (let [whole (frac-to-int value)
+ (let [whole (..int value)
whole-part (:: <int> encode whole)
decimal (|> value (..% +1.0) ..abs)
- decimal-part (if (f/= +0.0 decimal)
+ decimal-part (if (..= +0.0 decimal)
".0"
(loop [dec-left decimal
output ""]
- (if (f/= +0.0 dec-left)
+ (if (..= +0.0 dec-left)
("lux text concat" "." output)
(let [shifted (..* <base> dec-left)
- digit-idx (|> shifted (..% <base>) frac-to-int .nat)]
+ digit-idx (|> shifted (..% <base>) ..int .nat)]
(recur (..% +1.0 shifted)
("lux text concat" output ("lux text clip" digit-idx (inc digit-idx) <char-set>)))))))]
("lux text concat" whole-part decimal-part)))
@@ -133,14 +200,14 @@
output
(recur (dec muls-left)
(..* <base> output))))
- adjusted-decimal (|> decimal int-to-frac (../ div-power))
+ adjusted-decimal (|> decimal //int.frac (../ div-power))
dec-rev (case (:: //rev.hex decode ("lux text concat" "." decimal-part))
(#try.Success dec-rev)
dec-rev
(#try.Failure error)
(error! error))]
- (#try.Success (..+ (int-to-frac whole)
+ (#try.Success (..+ (//int.frac whole)
(..* sign adjusted-decimal))))
_
@@ -292,12 +359,12 @@
(let [sign (..signum value)
raw-bin (:: ..binary encode value)
dot-idx (maybe.assume ("lux text index" 0 "." raw-bin))
- whole-part ("lux text clip" (if (f/= -1.0 sign) 1 0) dot-idx raw-bin)
+ whole-part ("lux text clip" (if (..= -1.0 sign) 1 0) dot-idx raw-bin)
decimal-part ("lux text clip" (inc dot-idx) ("lux text size" raw-bin) raw-bin)
hex-output (|> (<from> #0 decimal-part)
("lux text concat" ".")
("lux text concat" (<from> #1 whole-part))
- ("lux text concat" (if (f/= -1.0 sign) "-" "")))]
+ ("lux text concat" (if (..= -1.0 sign) "-" "")))]
hex-output))
(def: (decode repr)
@@ -314,7 +381,7 @@
as-binary (|> (<to> decimal-part)
("lux text concat" ".")
("lux text concat" (<to> whole-part))
- ("lux text concat" (if (f/= -1.0 sign) "-" "+")))]
+ ("lux text concat" (if (..= -1.0 sign) "-" "+")))]
(case (:: ..binary decode as-binary)
(#try.Failure _)
(#try.Failure ("lux text concat" <error> repr))
@@ -355,15 +422,15 @@
(i64 (cond (not-a-number? input)
..not-a-number-bits
- (f/= positive-infinity input)
+ (..= positive-infinity input)
..positive-infinity-bits
- (f/= negative-infinity input)
+ (..= negative-infinity input)
..negative-infinity-bits
- (f/= +0.0 input)
+ (..= +0.0 input)
(let [reciprocal (../ input +1.0)]
- (if (f/= positive-infinity reciprocal)
+ (if (..= positive-infinity reciprocal)
## Positive zero
..positive-zero-bits
## Negative zero
@@ -378,11 +445,11 @@
(../ (math.pow exponent +2.0))
## Make it int-equivalent
(..* (math.pow +52.0 +2.0)))
- sign-bit (if (f/= -1.0 (..signum input))
+ sign-bit (if (..= -1.0 (..signum input))
1
0)
- exponent-bits (|> exponent frac-to-int .nat (n/+ double-bias) (//i64.and exponent-mask))
- mantissa-bits (|> mantissa frac-to-int .nat)]
+ exponent-bits (|> exponent ..int .nat (n/+ double-bias) (//i64.and exponent-mask))
+ mantissa-bits (|> mantissa ..int .nat)]
($_ //i64.or
(//i64.left-shift 63 sign-bit)
(//i64.left-shift mantissa-size exponent-bits)
@@ -419,10 +486,10 @@
## else
(let [normalized (|> M (//i64.set mantissa-size)
- .int int-to-frac
+ .int //int.frac
(../ (math.pow +52.0 +2.0)))
power (math.pow (|> E (n/- double-bias)
- .int int-to-frac)
+ .int //int.frac)
+2.0)
shifted (..* power
normalized)]
diff --git a/stdlib/source/lux/data/number/int.lux b/stdlib/source/lux/data/number/int.lux
index 9e1299ae2..f0e030f5b 100644
--- a/stdlib/source/lux/data/number/int.lux
+++ b/stdlib/source/lux/data/number/int.lux
@@ -16,23 +16,6 @@
[//
["." nat]])
-(structure: #export equivalence (Equivalence Int)
- (def: = i/=))
-
-(structure: #export order (Order Int)
- (def: &equivalence ..equivalence)
- (def: < i/<))
-
-(structure: #export enum (Enum Int)
- (def: &order ..order)
- (def: succ inc)
- (def: pred dec))
-
-(structure: #export interval (Interval Int)
- (def: &enum ..enum)
- (def: top +9,223,372,036,854,775,807)
- (def: bottom -9,223,372,036,854,775,808))
-
(def: #export + (-> Int Int Int) i/+)
(def: #export - (-> Int Int Int) i/-)
@@ -43,12 +26,17 @@
(def: #export % (-> Int Int Int) i/%)
-(def: #export negate (-> Int Int) (i/* -1))
+(def: #export (/% param subject)
+ (-> Int Int [Int Int])
+ [(../ param subject)
+ (..% param subject)])
+
+(def: #export negate (-> Int Int) (..* -1))
(def: #export (abs x)
(-> Int Int)
(if (i/< +0 x)
- (i/* -1 x)
+ (..* -1 x)
x))
(def: #export (signum x)
@@ -58,14 +46,42 @@
## else
+1))
+(def: #export (mod param subject)
+ (All [m] (-> Int Int Int))
+ (let [raw (..% param subject)]
+ (if (i/< +0 raw)
+ (let [shift (if (i/< +0 param) ..- ..+)]
+ (|> raw (shift param)))
+ raw)))
+
+(def: #export frac
+ (-> Int Frac)
+ (|>> "lux i64 f64"))
+
+(structure: #export equivalence (Equivalence Int)
+ (def: = i/=))
+
+(structure: #export order (Order Int)
+ (def: &equivalence ..equivalence)
+ (def: < i/<))
+
+(structure: #export enum (Enum Int)
+ (def: &order ..order)
+ (def: succ inc)
+ (def: pred dec))
+
+(structure: #export interval (Interval Int)
+ (def: &enum ..enum)
+ (def: top +9,223,372,036,854,775,807)
+ (def: bottom -9,223,372,036,854,775,808))
(template [<name> <compose> <identity>]
[(structure: #export <name> (Monoid Int)
(def: identity <identity>)
(def: compose <compose>))]
- [addition i/+ +0]
- [multiplication i/* +1]
+ [addition ..+ +0]
+ [multiplication ..* +1]
[maximum i/max (:: ..interval bottom)]
[minimum i/min (:: ..interval top)]
)
@@ -99,22 +115,22 @@
(#.Some digit-value)
(recur (inc idx)
- (|> output (i/* <base>) (i/+ (.int digit-value)))))
- (#try.Success (i/* sign output)))))
+ (|> output (..* <base>) (..+ (.int digit-value)))))
+ (#try.Success (..* sign output)))))
(template [<struct> <base> <to-character> <to-value> <error>]
[(structure: #export <struct> (Codec Text Int)
(def: (encode value)
(if (i/= +0 value)
"+0"
- (loop [input (|> value (i// <base>) ..abs)
- output (|> value (i/% <base>) ..abs .nat
+ (loop [input (|> value (../ <base>) ..abs)
+ output (|> value (..% <base>) ..abs .nat
<to-character>
maybe.assume)]
(if (i/= +0 input)
("lux text concat" (sign!! value) output)
- (let [digit (maybe.assume (<to-character> (.nat (i/% <base> input))))]
- (recur (i// <base> input)
+ (let [digit (maybe.assume (<to-character> (.nat (..% <base> input))))]
+ (recur (../ <base> input)
("lux text concat" digit output)))))))
(def: (decode repr)
diff --git a/stdlib/source/lux/data/number/nat.lux b/stdlib/source/lux/data/number/nat.lux
index a7c804f65..b86826fdd 100644
--- a/stdlib/source/lux/data/number/nat.lux
+++ b/stdlib/source/lux/data/number/nat.lux
@@ -15,35 +15,59 @@
["." maybe]
["." text (#+ Char)]]])
-(structure: #export equivalence (Equivalence Nat)
+(def: #export + (-> Nat Nat Nat) n/+)
+
+(def: #export - (-> Nat Nat Nat) n/-)
+
+(def: #export * (-> Nat Nat Nat) n/*)
+
+(def: #export / (-> Nat Nat Nat) n//)
+
+(def: #export % (-> Nat Nat Nat) n/%)
+
+(def: #export (/% param subject)
+ (-> Nat Nat [Nat Nat])
+ [(../ param subject)
+ (..% param subject)])
+
+(def: #export (mod param subject)
+ (-> Nat Nat Nat)
+ (let [exact (|> subject (../ param) (..* param))]
+ (|> subject (..- exact))))
+
+(def: #export frac
+ (-> Nat Frac)
+ (|>> .int "lux i64 f64"))
+
+(structure: #export equivalence
+ (Equivalence Nat)
+
(def: = n/=))
-(structure: #export order (Order Nat)
+(structure: #export order
+ (Order Nat)
+
(def: &equivalence ..equivalence)
(def: < n/<))
-(structure: #export enum (Enum Nat)
+(structure: #export enum
+ (Enum Nat)
+
(def: &order ..order)
(def: succ inc)
(def: pred dec))
-(structure: #export interval (Interval Nat)
+(structure: #export interval
+ (Interval Nat)
+
(def: &enum ..enum)
(def: top (.nat -1))
(def: bottom 0))
-(def: #export + (-> Nat Nat Nat) n/+)
-
-(def: #export - (-> Nat Nat Nat) n/-)
-
-(def: #export * (-> Nat Nat Nat) n/*)
-
-(def: #export / (-> Nat Nat Nat) n//)
-
-(def: #export % (-> Nat Nat Nat) n/%)
-
(template [<name> <compose> <identity>]
- [(structure: #export <name> (Monoid Nat)
+ [(structure: #export <name>
+ (Monoid Nat)
+
(def: identity <identity>)
(def: compose <compose>))]
diff --git a/stdlib/source/lux/data/number/rev.lux b/stdlib/source/lux/data/number/rev.lux
index 0633d5c0b..4091b292e 100644
--- a/stdlib/source/lux/data/number/rev.lux
+++ b/stdlib/source/lux/data/number/rev.lux
@@ -20,6 +20,32 @@
["#." nat]
["#." int]])
+(def: #export + (-> Rev Rev Rev) r/+)
+
+(def: #export - (-> Rev Rev Rev) r/-)
+
+(def: #export * (-> Rev Rev Rev) r/*)
+
+(def: #export / (-> Rev Rev Rev) r//)
+
+(def: #export % (-> Rev Rev Rev) r/%)
+
+(def: #export (/% param subject)
+ (-> Rev Rev [Rev Rev])
+ [(../ param subject)
+ (..% param subject)])
+
+(def: to-significand
+ (-> (I64 Any) Frac)
+ (|>> ("lux i64 logical-right-shift" 11)
+ "lux i64 f64"))
+
+(def: frac-denominator (to-significand -1))
+
+(def: #export frac
+ (-> Rev Frac)
+ (|>> to-significand ("lux f64 /" frac-denominator)))
+
(structure: #export equivalence (Equivalence Rev)
(def: = r/=))
@@ -42,7 +68,7 @@
(def: identity (:: interval <identity>))
(def: compose <compose>))]
- [addition r/+ bottom]
+ [addition ..+ bottom]
[maximum r/max bottom]
[minimum r/min top]
)
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-13 14:29:32 +0000