diff options
Diffstat (limited to '')
45 files changed, 749 insertions, 634 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index aff2f300a..f347c281a 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -2278,9 +2278,6 @@ [ Int "lux i64 =" "lux i64 <" i/= i/< i/<= i/> i/>= "Int(eger) equivalence." "Int(eger) less-than." "Int(eger) less-than-equal." "Int(eger) greater-than." "Int(eger) greater-than-equal."] - - [Frac "lux f64 =" "lux f64 <" f/= f/< f/<= f/> f/>= - "Frac(tion) equivalence." "Frac(tion) less-than." "Frac(tion) less-than-equal." "Frac(tion) greater-than." "Frac(tion) greater-than-equal."] ) (def:''' #export (n// param subject) @@ -2343,15 +2340,9 @@ (-> <type> <type> <type>) (<op> param subject))] - [ Int i/* "lux i64 *" "Int(eger) multiplication."] - [ Int i// "lux i64 /" "Int(eger) division."] - [ Int i/% "lux i64 %" "Int(eger) remainder."] - - [Frac f/+ "lux f64 +" "Frac(tion) addition."] - [Frac f/- "lux f64 -" "Frac(tion) substraction."] - [Frac f/* "lux f64 *" "Frac(tion) multiplication."] - [Frac f// "lux f64 /" "Frac(tion) division."] - [Frac f/% "lux f64 %" "Frac(tion) remainder."] + [Int i/* "lux i64 *" "Int(eger) multiplication."] + [Int i// "lux i64 /" "Int(eger) division."] + [Int i/% "lux i64 %" "Int(eger) remainder."] ) (def:''' #export (r/* param subject) @@ -2449,9 +2440,6 @@ [r/min Rev r/< "Rev(olution) minimum."] [r/max Rev r/> "Rev(olution) maximum."] - - [f/min Frac f/< "Frac(tion) minimum."] - [f/max Frac f/> "Frac(tion) minimum."] ) (def:''' (bit@encode x) @@ -5097,15 +5085,6 @@ _ (fail "Wrong syntax for ^template"))) -(template [<name> <from> <to> <proc>] - [(def: #export (<name> n) - (-> <from> <to>) - (<proc> n))] - - [frac-to-int Frac Int "lux f64 i64"] - [int-to-frac Int Frac "lux i64 f64"] - ) - (def: (find-baseline-column code) (-> Code Nat) (case code @@ -6132,52 +6111,6 @@ _ (fail (..wrong-syntax-error (name-of ..^code))))) -(def: #export (n/mod param subject) - (-> Nat Nat Nat) - (let [exact (|> subject (n// param) (n/* param))] - (|> subject (n/- exact)))) - -(def: #export (i/mod param subject) - (All [m] (-> Int Int Int)) - (let [raw (i/% param subject)] - (if (i/< +0 raw) - (let [shift (if (i/< +0 param) i/- i/+)] - (|> raw (shift param))) - raw))) - -(template [<type> </%> </> <%>] - [(def: #export (</%> param subject) - (-> <type> <type> [<type> <type>]) - [(</> param subject) - (<%> param subject)])] - - [Int i//% i// i/%] - [Rev r//% r// r/%] - [Frac f//% f// f/%] - ) - -(def: to-significand - (-> (I64 Any) Frac) - (|>> ("lux i64 logical-right-shift" 11) - int-to-frac)) - -(def: rev-denominator Frac (to-significand -1)) - -(def: #export (frac-to-rev input) - (-> Frac Rev) - (let [abs (if (f/< +0.0 input) - (f/* -1.0 input) - input)] - (|> abs - (f/% +1.0) - (f/* rev-denominator) - frac-to-int - ("lux i64 left-shift" 11)))) - -(def: #export rev-to-frac - (-> Rev Frac) - (|>> to-significand (f// rev-denominator))) - (def: #export (cursor-description [file line column]) (-> Cursor Text) (let [separator ", " @@ -6195,11 +6128,3 @@ [no yes] [off on] ) - -(def: #export nat-to-frac - (-> Nat Frac) - (|>> ..int ..int-to-frac)) - -(def: #export frac-to-nat - (-> Frac Nat) - (|>> ..frac-to-int ..nat)) diff --git a/stdlib/source/lux/control/concatenative.lux b/stdlib/source/lux/control/concatenative.lux index a821561b4..ebf1905f1 100644 --- a/stdlib/source/lux/control/concatenative.lux +++ b/stdlib/source/lux/control/concatenative.lux @@ -2,16 +2,17 @@ [lux (#- if loop when n/+ n/- n/* n// n/% n/= n/< n/<= n/> n/>= i/+ i/- i/* i// i/% i/= i/< i/<= i/> i/>= - r/+ r/- r/* r// r/% r/= r/< r/<= r/> r/>= - f/+ f/- f/* f// f/% f/= f/< f/<= f/> f/>=) + r/+ r/- r/* r// r/% r/= r/< r/<= r/> r/>=) [abstract ["." monad]] [data + ["." maybe ("#;." monad)] ["." text ["%" format (#+ format)]] - ["." maybe ("#;." monad)] [collection - ["." list ("#;." fold functor)]]] + ["." list ("#;." fold functor)]] + [number + ["f" frac]]] ["." macro (#+ with-gensyms) ["." code] [syntax (#+ syntax:) @@ -239,16 +240,16 @@ [Rev Bit r/> .r/>] [Rev Bit r/>= .r/>=] - [Frac Frac f/+ .f/+] - [Frac Frac f/- .f/-] - [Frac Frac f/* .f/*] - [Frac Frac f// .f//] - [Frac Frac f/% .f/%] - [Frac Bit f/= .f/=] - [Frac Bit f/< .f/<] - [Frac Bit f/<= .f/<=] - [Frac Bit f/> .f/>] - [Frac Bit f/>= .f/>=] + [Frac Frac f/+ f.+] + [Frac Frac f/- f.-] + [Frac Frac f/* f.*] + [Frac Frac f// f./] + [Frac Frac f/% f.%] + [Frac Bit f/= f.=] + [Frac Bit f/< f.<] + [Frac Bit f/<= f.<=] + [Frac Bit f/> f.>] + [Frac Bit f/>= f.>=] ) (def: #export if diff --git a/stdlib/source/lux/control/parser/code.lux b/stdlib/source/lux/control/parser/code.lux index 33ff0abe2..b20f707a3 100644 --- a/stdlib/source/lux/control/parser/code.lux +++ b/stdlib/source/lux/control/parser/code.lux @@ -6,13 +6,13 @@ ["." try (#+ Try)]] [data ["." bit] + ["." text ("#@." monoid)] ["." name] [number ["." nat] ["." int] ["." rev] ["." frac]] - ["." text ("#@." monoid)] [collection ["." list ("#@." functor)]]] [macro diff --git a/stdlib/source/lux/control/try.lux b/stdlib/source/lux/control/try.lux index 66c325c65..e4e4cae4a 100644 --- a/stdlib/source/lux/control/try.lux +++ b/stdlib/source/lux/control/try.lux @@ -1,10 +1,10 @@ (.module: [lux #* [abstract - ["." functor (#+ Functor)] [apply (#+ Apply)] - ["." monad (#+ Monad do)] - [equivalence (#+ Equivalence)]]]) + [equivalence (#+ Equivalence)] + ["." functor (#+ Functor)] + ["." monad (#+ Monad do)]]]) (type: #export (Try a) (#Failure Text) 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] ) diff --git a/stdlib/source/lux/macro/poly/json.lux b/stdlib/source/lux/macro/poly/json.lux index fec2d6c60..44fd4b628 100644 --- a/stdlib/source/lux/macro/poly/json.lux +++ b/stdlib/source/lux/macro/poly/json.lux @@ -19,6 +19,7 @@ [number ["." i64] ["." nat ("#@." decimal)] + ["." int] ["." frac ("#@." decimal)]] ["." text ("#@." equivalence) ["%" format (#+ format)]] @@ -43,7 +44,7 @@ (def: tag (-> Nat Frac) - (|>> .int int-to-frac)) + (|>> .int int.frac)) (def: (rec-encode non-rec) (All [a] (-> (-> (-> a JSON) @@ -59,16 +60,16 @@ (def: (encode input) (let [high (|> input (i64.and high-mask) (i64.logic-right-shift 32)) low (i64.and low-mask input)] - (#/.Array (row (|> high .int int-to-frac #/.Number) - (|> low .int int-to-frac #/.Number))))) + (#/.Array (row (|> high .int int.frac #/.Number) + (|> low .int int.frac #/.Number))))) (def: (decode input) (<| (</>.run input) </>.array (do p.monad [high </>.number low </>.number]) - (wrap (n/+ (|> high frac-to-int .nat (i64.left-shift 32)) - (|> low frac-to-int .nat)))))) + (wrap (n/+ (|> high frac.int .nat (i64.left-shift 32)) + (|> low frac.int .nat)))))) (structure: int-codec (codec.Codec JSON Int) (def: encode (|>> .nat (:: nat-codec encode))) diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux index 41627aca9..cf3f01d9c 100644 --- a/stdlib/source/lux/math.lux +++ b/stdlib/source/lux/math.lux @@ -1,11 +1,14 @@ (.module: {#.doc "Common mathematical constants and functions."} [lux #* - ["@" target]]) + ["@" target] + [data + [number + ["." nat] + ["." int]]]]) (template [<name> <value> <doc>] [(def: #export <name> {#.doc <doc>} - Frac <value>)] [e +2.7182818284590452354 "The base of the natural logarithm."] @@ -95,40 +98,41 @@ (def: #export (round input) (-> Frac Frac) (let [floored (floor input) - diff (f/- floored input)] - (cond (f/> +0.5 diff) - (f/+ +1.0 floored) + diff ("lux f64 -" floored input)] + (cond ("lux f64 <" diff +0.5) + ("lux f64 +" +1.0 floored) - (f/< -0.5 diff) - (f/+ -1.0 floored) + ("lux f64 <" -0.5 diff) + ("lux f64 +" -1.0 floored) ## else floored))) (def: #export (atan2 param subject) (-> Frac Frac Frac) - (cond (f/> +0.0 param) - (atan (f// param subject)) - - (f/< +0.0 param) - (if (f/>= +0.0 subject) - (|> subject (f// param) atan (f/+ pi)) - (|> subject (f// param) atan (f/- pi))) - - ## (f/= +0.0 param) - (cond (f/> +0.0 subject) - (|> pi (f// +2.0)) + (cond ("lux f64 <" param +0.0) + (atan ("lux f64 /" param subject)) + + ("lux f64 <" +0.0 param) + (if (or ("lux f64 <" subject +0.0) + ("lux f64 =" +0.0 subject)) + (|> subject ("lux f64 /" param) atan ("lux f64 +" pi)) + (|> subject ("lux f64 /" param) atan ("lux f64 -" pi))) + + ## ("lux f64 =" +0.0 param) + (cond ("lux f64 <" subject +0.0) + (|> pi ("lux f64 /" +2.0)) - (f/< +0.0 subject) - (|> pi (f// -2.0)) + ("lux f64 <" +0.0 subject) + (|> pi ("lux f64 /" -2.0)) - ## (f/= +0.0 subject) - (f// +0.0 +0.0)))) + ## ("lux f64 =" +0.0 subject) + ("lux f64 /" +0.0 +0.0)))) (def: #export (log' base input) (-> Frac Frac Frac) - (f// (log base) - (log input))) + ("lux f64 /" (log base) + (log input))) (def: #export (factorial n) (-> Nat Nat) @@ -140,8 +144,9 @@ (def: #export (hypotenuse catA catB) (-> Frac Frac Frac) - (pow +0.5 (f/+ (pow +2.0 catA) - (pow +2.0 catB)))) + (pow +0.5 ("lux f64 +" + (pow +2.0 catA) + (pow +2.0 catB)))) (template [<type> <mod> <gcd> <lcm> <zero> <*> </> <->] [(def: #export (<gcd> a b) @@ -162,8 +167,8 @@ (|> a (</> (<gcd> a b)) (<*> b)) ))] - [Nat n/mod n/gcd n/lcm 0 n/* n// n/-] - [Int i/mod i/gcd i/lcm +0 i/* i// i/-] + [Nat nat.mod n/gcd n/lcm 0 n/* n// n/-] + [Int int.mod i/gcd i/lcm +0 i/* i// i/-] ) ## Hyperbolic functions @@ -171,24 +176,24 @@ (template [<name> <comp> <inverse>] [(def: #export (<name> x) (-> Frac Frac) - (|> (exp x) (<comp> (exp (f/* -1.0 x))) (f// +2.0))) + (|> (exp x) (<comp> (exp ("lux f64 *" -1.0 x))) ("lux f64 /" +2.0))) (def: #export (<inverse> x) (-> Frac Frac) - (|> +2.0 (f// (|> (exp x) (<comp> (exp (f/* -1.0 x)))))))] + (|> +2.0 ("lux f64 /" (|> (exp x) (<comp> (exp ("lux f64 *" -1.0 x)))))))] - [sinh f/- csch] - [cosh f/+ sech] + [sinh "lux f64 -" csch] + [cosh "lux f64 +" sech] ) (template [<name> <top> <bottom>] [(def: #export (<name> x) (-> Frac Frac) (let [e+ (exp x) - e- (exp (f/* -1.0 x)) - sinh' (|> e+ (f/- e-)) - cosh' (|> e+ (f/+ e-))] - (|> <top> (f// <bottom>))))] + e- (exp ("lux f64 *" -1.0 x)) + sinh' (|> e+ ("lux f64 -" e-)) + cosh' (|> e+ ("lux f64 +" e-))] + (|> <top> ("lux f64 /" <bottom>))))] [tanh sinh' cosh'] [coth cosh' sinh'] @@ -198,18 +203,18 @@ (template [<name> <comp>] [(def: #export (<name> x) (-> Frac Frac) - (|> x (pow +2.0) (<comp> +1.0) (pow +0.5) (f/+ x) log))] + (|> x (pow +2.0) (<comp> +1.0) (pow +0.5) ("lux f64 +" x) log))] - [asinh f/+] - [acosh f/-] + [asinh "lux f64 +"] + [acosh "lux f64 -"] ) (template [<name> <base> <diff>] [(def: #export (<name> x) (-> Frac Frac) - (let [x+ (|> <base> (f/+ <diff>)) - x- (|> <base> (f/- <diff>))] - (|> x+ (f// x-) log (f// +2.0))))] + (let [x+ (|> <base> ("lux f64 +" <diff>)) + x- (|> <base> ("lux f64 -" <diff>))] + (|> x+ ("lux f64 /" x-) log ("lux f64 /" +2.0))))] [atanh +1.0 x] [acoth x +1.0] @@ -219,8 +224,8 @@ [(def: #export (<name> x) (-> Frac Frac) (let [x^2 (|> x (pow +2.0))] - (|> +1.0 (<op> x^2) (pow +0.5) (f/+ +1.0) (f// x) log)))] + (|> +1.0 (<op> x^2) (pow +0.5) ("lux f64 +" +1.0) ("lux f64 /" x) log)))] - [asech f/-] - [acsch f/+] + [asech "lux f64 -"] + [acsch "lux f64 +"] ) diff --git a/stdlib/source/lux/math/modular.lux b/stdlib/source/lux/math/modular.lux index b0f8be77a..2ec37ed2a 100644 --- a/stdlib/source/lux/math/modular.lux +++ b/stdlib/source/lux/math/modular.lux @@ -77,7 +77,7 @@ (def: #export (mod modulus) (All [m] (-> (Modulus m) (-> Int (Mod m)))) (function (_ value) - (:abstraction {#remainder (i/mod (to-int modulus) value) + (:abstraction {#remainder (int.mod (to-int modulus) value) #modulus modulus}))) (def: #export (un-mod modular) @@ -120,11 +120,11 @@ [sample _] (:representation sample)] (<op> reference sample)))] - [m/= i/=] - [m/< i/<] - [m/<= i/<=] - [m/> i/>] - [m/>= i/>=] + [= i/=] + [< i/<] + [<= i/<=] + [> i/>] + [>= i/>=] ) (template [<name> <op>] @@ -134,12 +134,13 @@ [subject _] (:representation subject)] (:abstraction {#remainder (|> subject (<op> param) - (i/mod (to-int modulus))) + (int.mod (to-int modulus))) #modulus modulus})))] - [m/+ i/+] - [m/- i/-] - [m/* i/*]) + [+ i/+] + [- i/-] + [* i/*] + ) (def: (i/gcd+ a b) (-> Int Int [Int Int Int]) diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux index 1bdc9931a..cf82955ca 100644 --- a/stdlib/source/lux/math/random.lux +++ b/stdlib/source/lux/math/random.lux @@ -10,9 +10,10 @@ ["." maybe] [number (#+ hex) ["." i64] + ["." int] ["r" ratio] ["c" complex] - ["." frac]] + ["f" frac]] ["." text (#+ Char) ("#;." monoid) ["." unicode (#+ Segment)]] [collection @@ -111,16 +112,16 @@ (def: #export frac (Random Frac) - (:: ..monad map (|>> .i64 frac.from-bits) ..nat)) + (:: ..monad map (|>> .i64 f.from-bits) ..nat)) (def: #export safe-frac (Random Frac) (let [mantissa-range (.int (i64.left-shift 53 1)) - mantissa-max (.int-to-frac (dec mantissa-range))] + mantissa-max (int.frac (dec mantissa-range))] (:: ..monad map (|>> (i/% mantissa-range) - .int-to-frac - (f// mantissa-max)) + int.frac + (f./ mantissa-max)) ..int))) (def: #export (char set) diff --git a/stdlib/source/lux/target/common-lisp.lux b/stdlib/source/lux/target/common-lisp.lux index 57b22300b..15330928d 100644 --- a/stdlib/source/lux/target/common-lisp.lux +++ b/stdlib/source/lux/target/common-lisp.lux @@ -4,7 +4,7 @@ [pipe (#+ case> cond> new>)]] [data [number - ["." frac]] + ["f" frac]] ["." text ["%" format (#+ format)]] [collection @@ -83,13 +83,13 @@ (def: #export float (-> Frac Literal) - (|>> (cond> [(f/= frac.positive-infinity)] + (|>> (cond> [(f.= f.positive-infinity)] [(new> "(/ 1.0 0.0)" [])] - [(f/= frac.negative-infinity)] + [(f.= f.negative-infinity)] [(new> "(/ -1.0 0.0)" [])] - [frac.not-a-number?] + [f.not-a-number?] [(new> "(/ 0.0 0.0)" [])] ## else @@ -99,13 +99,13 @@ (def: #export (double value) (-> Frac Literal) (:abstraction - (.cond (f/= frac.positive-infinity value) + (.cond (f.= f.positive-infinity value) "(/ 1.0d0 0.0d0)" - (f/= frac.negative-infinity value) + (f.= f.negative-infinity value) "(/ -1.0d0 0.0d0)" - (frac.not-a-number? value) + (f.not-a-number? value) "(/ 0.0d0 0.0d0)" ## else diff --git a/stdlib/source/lux/target/js.lux b/stdlib/source/lux/target/js.lux index d00a44b84..47c8d9d8c 100644 --- a/stdlib/source/lux/target/js.lux +++ b/stdlib/source/lux/target/js.lux @@ -4,7 +4,7 @@ [pipe (#+ case>)]] [data [number - ["." frac]] + ["f" frac]] ["." text ["%" format (#+ format)]] [collection @@ -64,13 +64,13 @@ (def: #export (number value) (-> Frac Literal) (:abstraction - (.cond (frac.not-a-number? value) + (.cond (f.not-a-number? value) "NaN" - (f/= frac.positive-infinity value) + (f.= f.positive-infinity value) "Infinity" - (f/= frac.negative-infinity value) + (f.= f.negative-infinity value) "-Infinity" ## else diff --git a/stdlib/source/lux/target/lua.lux b/stdlib/source/lux/target/lua.lux index d9907dbc4..7aa62345f 100644 --- a/stdlib/source/lux/target/lua.lux +++ b/stdlib/source/lux/target/lua.lux @@ -6,7 +6,7 @@ ["s" code]]] [data [number - ["." frac]] + ["f" frac]] ["." text ["%" format (#+ format)]] [collection @@ -79,13 +79,13 @@ (def: #export float (-> Frac Literal) - (|>> (cond> [(f/= frac.positive-infinity)] + (|>> (cond> [(f.= f.positive-infinity)] [(new> "(1.0/0.0)" [])] - [(f/= frac.negative-infinity)] + [(f.= f.negative-infinity)] [(new> "(-1.0/0.0)" [])] - [(f/= frac.not-a-number)] + [(f.= f.not-a-number)] [(new> "(0.0/0.0)" [])] ## else diff --git a/stdlib/source/lux/target/php.lux b/stdlib/source/lux/target/php.lux index 198a1de75..577b202f1 100644 --- a/stdlib/source/lux/target/php.lux +++ b/stdlib/source/lux/target/php.lux @@ -4,7 +4,7 @@ [pipe (#+ case> cond> new>)]] [data [number - ["." frac]] + ["f" frac]] ["." text ["%" format (#+ format)]] [collection @@ -101,13 +101,13 @@ (def: #export float (-> Frac Literal) - (|>> (cond> [(f/= frac.positive-infinity)] + (|>> (cond> [(f.= f.positive-infinity)] [(new> "+INF" [])] - [(f/= frac.negative-infinity)] + [(f.= f.negative-infinity)] [(new> "-INF" [])] - [(f/= frac.not-a-number)] + [(f.= f.not-a-number)] [(new> "NAN" [])] ## else diff --git a/stdlib/source/lux/target/python.lux b/stdlib/source/lux/target/python.lux index 31cdd851d..ef1098095 100644 --- a/stdlib/source/lux/target/python.lux +++ b/stdlib/source/lux/target/python.lux @@ -6,7 +6,7 @@ ["s" code]]] [data [number - ["." frac]] + ["f" frac]] ["." text ["%" format (#+ format)]] [collection @@ -106,12 +106,12 @@ (def: #export float (-> Frac Literal) (`` (|>> (cond> (~~ (template [<lux> <python>] - [[(f/= <lux>)] + [[(f.= <lux>)] [(new> (format "float(" text.double-quote <python> text.double-quote ")") [])]] - [frac.positive-infinity "inf"] - [frac.negative-infinity "-inf"] - [frac.not-a-number "nan"] + [f.positive-infinity "inf"] + [f.negative-infinity "-inf"] + [f.not-a-number "nan"] )) ## else diff --git a/stdlib/source/lux/target/ruby.lux b/stdlib/source/lux/target/ruby.lux index 01c97bf8a..9a0617204 100644 --- a/stdlib/source/lux/target/ruby.lux +++ b/stdlib/source/lux/target/ruby.lux @@ -4,7 +4,7 @@ [pipe (#+ case> cond> new>)]] [data [number - ["." frac]] + ["f" frac]] ["." text ["%" format (#+ format)]] [collection @@ -151,13 +151,13 @@ (def: #export float (-> Frac Literal) - (|>> (cond> [(f/= frac.positive-infinity)] + (|>> (cond> [(f.= f.positive-infinity)] [(new> "(+1.0/0.0)" [])] - [(f/= frac.negative-infinity)] + [(f.= f.negative-infinity)] [(new> "(-1.0/0.0)" [])] - [(f/= frac.not-a-number)] + [(f.= f.not-a-number)] [(new> "(+0.0/-0.0)" [])] ## else diff --git a/stdlib/source/lux/target/scheme.lux b/stdlib/source/lux/target/scheme.lux index 652771c1c..0d70aeb58 100644 --- a/stdlib/source/lux/target/scheme.lux +++ b/stdlib/source/lux/target/scheme.lux @@ -4,7 +4,7 @@ [pipe (#+ new> cond> case>)]] [data [number - ["." frac]] + ["f" frac]] ["." text ["%" format (#+ format)]] [collection @@ -82,22 +82,22 @@ (def: #export float (-> Frac Computation) - (|>> (cond> [(f/= frac.positive-infinity)] + (|>> (cond> [(f.= f.positive-infinity)] [(new> "+inf.0" [])] - [(f/= frac.negative-infinity)] + [(f.= f.negative-infinity)] [(new> "-inf.0" [])] - [frac.not-a-number?] + [f.not-a-number?] [(new> "+nan.0" [])] ## else [%.frac]) :abstraction)) - (def: #export positive-infinity Computation (..float frac.positive-infinity)) - (def: #export negative-infinity Computation (..float frac.negative-infinity)) - (def: #export not-a-number Computation (..float frac.not-a-number)) + (def: #export positive-infinity Computation (..float f.positive-infinity)) + (def: #export negative-infinity Computation (..float f.negative-infinity)) + (def: #export not-a-number Computation (..float f.not-a-number)) (def: sanitize (-> Text Text) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/extension/common.lux index 8f323544e..0d56d70b6 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/extension/common.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/extension/common.lux @@ -7,6 +7,8 @@ ["." function]] [data ["." product] + [number + ["f" frac]] [collection ["." dictionary]]] [target @@ -72,7 +74,7 @@ (_.double <const>))] [f64//smallest (java/lang/Double::MIN_VALUE)] - [f64//min (f/* -1.0 (java/lang/Double::MAX_VALUE))] + [f64//min (f.* -1.0 (java/lang/Double::MAX_VALUE))] [f64//max (java/lang/Double::MAX_VALUE)] ) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux index 9baf594da..858a46c44 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux @@ -9,6 +9,8 @@ ["<s>" synthesis (#+ Parser)]]] [data ["." product] + [number + ["f" frac]] [collection ["." list ("#@." functor)] ["." dictionary]]] @@ -62,7 +64,7 @@ (///primitive.f64 <const>))] [f64//smallest (java/lang/Double::MIN_VALUE)] - [f64//min (f/* -1.0 (java/lang/Double::MAX_VALUE))] + [f64//min (f.* -1.0 (java/lang/Double::MAX_VALUE))] [f64//max (java/lang/Double::MAX_VALUE)] ) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/lua/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/lua/extension/common.lux index 25159b2a7..5b57e7538 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/lua/extension/common.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/lua/extension/common.lux @@ -7,6 +7,8 @@ ["." function]] [data ["." product] + [number + ["f" frac]] [collection ["." dictionary]]] [target @@ -66,7 +68,7 @@ (_.float <const>))] [frac//smallest (java/lang/Double::MIN_VALUE)] - [frac//min (f/* -1.0 (java/lang/Double::MAX_VALUE))] + [frac//min (f.* -1.0 (java/lang/Double::MAX_VALUE))] [frac//max (java/lang/Double::MAX_VALUE)] ) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/php/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/php/extension/common.lux index 74f61fd22..07f76e258 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/php/extension/common.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/php/extension/common.lux @@ -8,6 +8,8 @@ [data ["." product] ["." text] + [number + ["f" frac]] [collection ["." dictionary]]] [target @@ -64,7 +66,7 @@ (_.float <const>))] [frac//smallest (java/lang/Double::MIN_VALUE)] - [frac//min (f/* -1.0 (java/lang/Double::MAX_VALUE))] + [frac//min (f.* -1.0 (java/lang/Double::MAX_VALUE))] [frac//max (java/lang/Double::MAX_VALUE)] ) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/python/extension/common.lux index 0714fd26c..b9fd166cc 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/python/extension/common.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/python/extension/common.lux @@ -7,6 +7,8 @@ ["." function]] [data ["." product] + [number + ["f" frac]] [collection ["." dictionary]]] [target @@ -63,7 +65,7 @@ (_.float <const>))] [frac//smallest (java/lang/Double::MIN_VALUE)] - [frac//min (f/* -1.0 (java/lang/Double::MAX_VALUE))] + [frac//min (f.* -1.0 (java/lang/Double::MAX_VALUE))] [frac//max (java/lang/Double::MAX_VALUE)] ) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/ruby/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/ruby/extension/common.lux index 80dbb312c..0ebfe1ab5 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/ruby/extension/common.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/ruby/extension/common.lux @@ -8,6 +8,8 @@ [data ["." product] ["." text] + [number + ["f" frac]] [collection ["." dictionary]]] [target @@ -59,7 +61,7 @@ (_.float <const>))] [frac//smallest (java/lang/Double::MIN_VALUE)] - [frac//min (f/* -1.0 (java/lang/Double::MAX_VALUE))] + [frac//min (f.* -1.0 (java/lang/Double::MAX_VALUE))] [frac//max (java/lang/Double::MAX_VALUE)] ) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/scheme/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/scheme/extension/common.lux index e23692e88..19776e6f5 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/scheme/extension/common.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/scheme/extension/common.lux @@ -10,7 +10,8 @@ [data ["." product] ["." text] - [number (#+ hex)] + [number (#+ hex) + ["f" frac]] [collection ["." list ("#;." functor)] ["dict" dictionary (#+ Dictionary)]]] @@ -109,7 +110,7 @@ (<encode> <const>))] [f64::smallest (Double::MIN_VALUE) _.float] - [f64::min (f/* -1.0 (Double::MAX_VALUE)) _.float] + [f64::min (f.* -1.0 (Double::MAX_VALUE)) _.float] [f64::max (Double::MAX_VALUE) _.float] ) diff --git a/stdlib/source/lux/tool/compiler/synthesis.lux b/stdlib/source/lux/tool/compiler/synthesis.lux index edb618dd4..de91d38a7 100644 --- a/stdlib/source/lux/tool/compiler/synthesis.lux +++ b/stdlib/source/lux/tool/compiler/synthesis.lux @@ -9,6 +9,8 @@ ["." bit ("#;." equivalence)] ["." text ("#;." equivalence) ["%" format (#+ Format format)]] + [number + ["f" frac]] [collection ["." list ("#;." functor)] ["." dictionary (#+ Dictionary)]]]] @@ -394,7 +396,7 @@ [(<tag> reference') (<tag> sample')] (<eq> reference' sample')) ([#Bit bit;= %.bit] - [#F64 f/= %.frac] + [#F64 f.= %.frac] [#Text text;= %.text]) [(#I64 reference') (#I64 sample')] diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index 5a1903a31..805a6ca05 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -18,6 +18,9 @@ ["." binary (#+ Binary)] ["." text ["%" format (#+ format)]] + [number + ["." int] + ["f" frac]] [collection ["." array (#+ Array)] ["." list ("#@." functor)]]] @@ -444,7 +447,7 @@ (function (last-modified _) (|> (Fs::statSync [path] (!fs)) (:: try.monad map (|>> Stats::mtimeMs - frac-to-int + f.int duration.from-millis instant.absolute)) io.io)))) @@ -471,7 +474,7 @@ (def: modify (..can-modify (function (modify time-stamp) - (io.io (let [when (|> time-stamp instant.relative duration.to-millis int-to-frac)] + (io.io (let [when (|> time-stamp instant.relative duration.to-millis int.frac)] (Fs::utimesSync [path when when] (!fs))))))) (def: delete diff --git a/stdlib/source/program/licentia/input.lux b/stdlib/source/program/licentia/input.lux index 7af7c33d4..6d64515cf 100644 --- a/stdlib/source/program/licentia/input.lux +++ b/stdlib/source/program/licentia/input.lux @@ -8,7 +8,10 @@ [text ["%" format (#+ format)]] [format - ["." json (#+ Reader)]]]] + ["." json (#+ Reader)]] + [number + ["." int] + ["f" frac]]]] [// [license (#+ Identification Termination @@ -39,10 +42,10 @@ (Reader Nat) (do parser.monad [amountF json.number - #let [amountI (frac-to-int amountF)] + #let [amountI (f.int amountF)] _ (parser.assert (ex.construct cannot-use-fractional-amount amountF) - (f/= amountF - (int-to-frac amountI))) + (f.= amountF + (int.frac amountI))) _ (parser.assert (ex.construct cannot-use-negative-amount amountI) (i/> +0 amountI))] (wrap (.nat amountI)))) diff --git a/stdlib/source/spec/compositor/generation/case.lux b/stdlib/source/spec/compositor/generation/case.lux index 43069bcb4..00a5e4d7c 100644 --- a/stdlib/source/spec/compositor/generation/case.lux +++ b/stdlib/source/spec/compositor/generation/case.lux @@ -9,6 +9,8 @@ [data ["." text ("#@." equivalence) ["%" format (#+ format)]] + [number + ["f" frac]] [collection ["." list ("#@." fold)]]] [math @@ -38,7 +40,7 @@ (def: #export (verify expected) (-> Frac (Try Any) Bit) (|>> (case> (#try.Success actual) - (f/= expected (:coerce Frac actual)) + (f.= expected (:coerce Frac actual)) (#try.Failure _) false))) @@ -108,7 +110,7 @@ (-> Runner Test) (do r.monad [on-true r.safe-frac - on-false (|> r.safe-frac (r.filter (|>> (f/= on-true) not))) + on-false (|> r.safe-frac (r.filter (|>> (f.= on-true) not))) verdict r.bit] (_.test (%.name (name-of synthesis.branch/if)) (|> (synthesis.branch/if [(synthesis.bit verdict) @@ -122,7 +124,7 @@ (do r.monad [[inputS pathS] ..case on-success r.safe-frac - on-failure (|> r.safe-frac (r.filter (|>> (f/= on-success) not)))] + on-failure (|> r.safe-frac (r.filter (|>> (f.= on-success) not)))] (_.test (%.name (name-of synthesis.branch/case)) (|> (synthesis.branch/case [inputS diff --git a/stdlib/source/spec/compositor/generation/common.lux b/stdlib/source/spec/compositor/generation/common.lux index f10f2a2ef..e2e6199d9 100644 --- a/stdlib/source/spec/compositor/generation/common.lux +++ b/stdlib/source/spec/compositor/generation/common.lux @@ -9,7 +9,9 @@ [data ["." bit ("#@." equivalence)] [number - ["." i64]] + ["." i64] + ["." int] + ["f" frac]] ["." text ("#@." equivalence) ["%" format (#+ format)]] [collection @@ -86,7 +88,7 @@ false) (let [subject <subject-expr>])))] - ["lux i64 f64" Frac int-to-frac f/= subject] + ["lux i64 f64" Frac int.frac f.= subject] ["lux i64 char" Text (|>> (:coerce Nat) text.from-code) text@= (|> subject (:coerce Nat) (n/% (i64.left-shift 8 1)) @@ -115,12 +117,12 @@ (def: simple-frac (Random Frac) - (|> r.nat (:: r.monad map (|>> (n/% 1000) .int int-to-frac)))) + (|> r.nat (:: r.monad map (|>> (n/% 1000) .int int.frac)))) (def: (f64 run) (-> Runner Test) (do r.monad - [param (|> ..simple-frac (r.filter (|>> (f/= +0.0) not))) + [param (|> ..simple-frac (r.filter (|>> (f.= +0.0) not))) subject ..simple-frac] (`` ($_ _.and (~~ (template [<extension> <reference> <comp>] @@ -130,11 +132,11 @@ (run (..sanitize <extension>)) (//case.verify (<reference> param subject))))] - ["lux f64 +" f/+ f/=] - ["lux f64 -" f/- f/=] - ["lux f64 *" f/* f/=] - ["lux f64 /" f// f/=] - ["lux f64 %" f/% f/=] + ["lux f64 +" f.+ f.=] + ["lux f64 -" f.- f.=] + ["lux f64 *" f.* f.=] + ["lux f64 /" f./ f.=] + ["lux f64 %" f.% f.=] )) (~~ (template [<extension> <text>] [(_.test <extension> @@ -148,8 +150,8 @@ _ false)))] - ["lux f64 =" f/=] - ["lux f64 <" f/<] + ["lux f64 =" f.=] + ["lux f64 <" f.<] )) (~~ (template [<extension> <reference>] [(_.test <extension> diff --git a/stdlib/source/spec/compositor/generation/primitive.lux b/stdlib/source/spec/compositor/generation/primitive.lux index e3068a50a..e5b601677 100644 --- a/stdlib/source/spec/compositor/generation/primitive.lux +++ b/stdlib/source/spec/compositor/generation/primitive.lux @@ -9,7 +9,7 @@ [data ["." bit ("#@." equivalence)] [number - ["." frac]] + ["f" frac]] ["." text ("#@." equivalence) ["%" format (#+ format)]]] [math @@ -22,9 +22,9 @@ (def: (f/=' reference subject) (-> Frac Frac Bit) - (or (f/= reference subject) - (and (frac.not-a-number? reference) - (frac.not-a-number? subject)))) + (or (f.= reference subject) + (and (f.not-a-number? reference) + (f.not-a-number? subject)))) (def: #export (spec run) (-> Runner Test) @@ -42,7 +42,7 @@ ["bit" synthesis.bit r.bit bit@=] ["i64" synthesis.i64 r.i64 "lux i64 ="] - ["f64" synthesis.f64 r.frac f/='] + ["f64" synthesis.f64 r.frac f.='] ["text" synthesis.text (r.ascii 5) text@=] )) ))) diff --git a/stdlib/source/spec/compositor/generation/reference.lux b/stdlib/source/spec/compositor/generation/reference.lux index eb5e3bf92..a5e75b590 100644 --- a/stdlib/source/spec/compositor/generation/reference.lux +++ b/stdlib/source/spec/compositor/generation/reference.lux @@ -6,6 +6,9 @@ [control [pipe (#+ case>)] ["." try]] + [data + [number + ["f" frac]]] [tool [compiler ["." reference] @@ -28,7 +31,7 @@ (_.test "Definitions." (|> (define name (synthesis.f64 expected)) (case> (#try.Success actual) - (f/= expected (:coerce Frac actual)) + (f.= expected (:coerce Frac actual)) (#try.Failure _) false))))) @@ -44,7 +47,7 @@ (synthesis.variable/local register)]) (run "variable") (case> (#try.Success actual) - (f/= expected (:coerce Frac actual)) + (f.= expected (:coerce Frac actual)) (#try.Failure _) false))))) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 945fd9c54..e1039d506 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -1,10 +1,10 @@ (.with-expansions [<host-modules> (.as-is [runtime (#+)] [primitive (#+)] [structure (#+)] + [function (#+)] [reference (#+)] [case (#+)] [loop (#+)] - [function (#+)] [extension (#+)])] (.module: ["/" lux #* @@ -19,7 +19,10 @@ [data ["." name] [number - ["." i64]]] + ["." i64] + ["." int] + ["." rev] + ["f" frac]]] ["." math] ["_" test (#+ Test)] ## These modules do not need to be tested. @@ -35,7 +38,7 @@ [format [css (#+)] [markdown (#+)]]] - [target + ["@" target [js (#+)] [python (#+)] [lua (#+)] @@ -47,6 +50,8 @@ [compiler [phase [generation + [jvm (#+) + <host-modules>] [js (#+) <host-modules>] [python (#+) @@ -291,9 +296,10 @@ on-default))) (_.test "Can pick code depending on the host/platform being targeted." (n/= on-valid-host - (for {"JVM" on-valid-host - "JS" on-valid-host} - on-default)))))) + (`` (for {(~~ (static @.old)) on-valid-host + (~~ (static @.jvm)) on-valid-host + (~~ (static @.js)) on-valid-host} + on-default))))))) (def: test (<| (_.context (name.module (name-of /._))) @@ -314,10 +320,10 @@ [(<| (_.context <context>) (..minimum-and-maximum <gen> <=> [<lt> <min>] [<gt> <max>]))] - [i/= i/< i/min i/> i/max r.int "Integers."] - [n/= n/< n/min n/> n/max r.nat "Natural numbers."] - [r/= r/< r/min r/> r/max r.rev "Revolutions."] - [f/= f/< f/min f/> f/max r.frac "Fractions."] + [i/= i/< i/min i/> i/max r.int "Integers."] + [n/= n/< n/min n/> n/max r.nat "Natural numbers."] + [r/= r/< r/min r/> r/max r.rev "Revolutions."] + [f.= f.< f.min f.> f.max r.safe-frac "Fractions."] ))))) (<| (_.context "Conversion.") (`` ($_ _.and @@ -326,11 +332,11 @@ " " (%.name (name-of <backward>)))) (..conversion <gen> <forward> <backward> <=>))] - [i/= .nat .int (r@map (i/% +1,000,000) r.int)] - [n/= .int .nat (r@map (n/% 1,000,000) r.nat)] - [i/= .int-to-frac .frac-to-int (r@map (i/% +1,000,000) r.int)] - [f/= .frac-to-int .int-to-frac (r@map (|>> (i/% +1,000,000) .int-to-frac) r.int)] - [r/= .rev-to-frac .frac-to-rev frac-rev] + [i/= .nat .int (r@map (i/% +1,000,000) r.int)] + [n/= .int .nat (r@map (n/% 1,000,000) r.nat)] + [i/= int.frac f.int (r@map (i/% +1,000,000) r.int)] + [f.= f.int int.frac (r@map (|>> (i/% +1,000,000) int.frac) r.int)] + [r/= rev.frac f.rev frac-rev] ))))) (<| (_.context "Prelude macros.") ..prelude-macros) diff --git a/stdlib/source/test/lux/data/color.lux b/stdlib/source/test/lux/data/color.lux index ee3bdffb1..79e771ce9 100644 --- a/stdlib/source/test/lux/data/color.lux +++ b/stdlib/source/test/lux/data/color.lux @@ -9,7 +9,8 @@ [data ["%" text/format (#+ format)] [number - ["." frac]]] + ["." int] + ["f" frac]]] ["." math ["r" random (#+ Random)]]] {1 @@ -22,7 +23,7 @@ (def: scale (-> Nat Frac) - (|>> .int int-to-frac)) + (|>> .int int.frac)) (def: square (-> Frac Frac) (math.pow +2.0)) @@ -30,10 +31,10 @@ (-> Color Color Frac) (let [[fr fg fb] (/.to-rgb from) [tr tg tb] (/.to-rgb to)] - (math.pow +0.5 ($_ f/+ - (|> (scale tr) (f/- (scale fr)) square) - (|> (scale tg) (f/- (scale fg)) square) - (|> (scale tb) (f/- (scale fb)) square))))) + (math.pow +0.5 ($_ f.+ + (|> (scale tr) (f.- (scale fr)) square) + (|> (scale tg) (f.- (scale fg)) square) + (|> (scale tb) (f.- (scale fb)) square))))) (def: error-margin Frac +1.8) @@ -56,32 +57,32 @@ (do r.monad [any ..color colorful (|> color - (r.filter (function (_ color) (|> (distance color black) (f/>= +100.0)))) - (r.filter (function (_ color) (|> (distance color white) (f/>= +100.0))))) + (r.filter (function (_ color) (|> (distance color black) (f.>= +100.0)))) + (r.filter (function (_ color) (|> (distance color white) (f.>= +100.0))))) mediocre (|> color (r.filter (|>> saturation ((function (_ saturation) - (and (f/>= +0.25 saturation) - (f/<= +0.75 saturation))))))) - ratio (|> r.safe-frac (r.filter (f/>= +0.5)))] + (and (f.>= +0.25 saturation) + (f.<= +0.75 saturation))))))) + ratio (|> r.safe-frac (r.filter (f.>= +0.5)))] ($_ _.and ($equivalence.spec /.equivalence ..color) (_.test "Can convert to/from HSL." (|> any /.to-hsl /.from-hsl (distance any) - (f/<= error-margin))) + (f.<= error-margin))) (_.test "Can convert to/from HSB." (|> any /.to-hsb /.from-hsb (distance any) - (f/<= error-margin))) + (f.<= error-margin))) (_.test "Can convert to/from CMYK." (|> any /.to-cmyk /.from-cmyk (distance any) - (f/<= error-margin))) + (f.<= error-margin))) (_.test "Can interpolate between 2 colors." - (and (f/<= (distance colorful black) + (and (f.<= (distance colorful black) (distance (/.darker ratio colorful) black)) - (f/<= (distance colorful white) + (f.<= (distance colorful white) (distance (/.brighter ratio colorful) white)))) (_.test "Can calculate complement." (let [~any (/.complement any) @@ -89,17 +90,17 @@ (and (not (/@= any ~any)) (/@= any (/.complement ~any))))) (_.test "Can saturate color." - (f/> (saturation mediocre) + (f.> (saturation mediocre) (saturation (/.saturate ratio mediocre)))) (_.test "Can de-saturate color." - (f/< (saturation mediocre) + (f.< (saturation mediocre) (saturation (/.de-saturate ratio mediocre)))) (_.test "Can gray-scale color." (let [gray'ed (/.gray-scale mediocre)] - (and (f/= +0.0 + (and (f.= +0.0 (saturation gray'ed)) (|> (luminance gray'ed) - (f/- (luminance mediocre)) - frac.abs - (f/<= error-margin))))) + (f.- (luminance mediocre)) + f.abs + (f.<= error-margin))))) )))) diff --git a/stdlib/source/test/lux/data/number/complex.lux b/stdlib/source/test/lux/data/number/complex.lux index 52e43a77e..1aa14e5be 100644 --- a/stdlib/source/test/lux/data/number/complex.lux +++ b/stdlib/source/test/lux/data/number/complex.lux @@ -11,7 +11,8 @@ ["$." codec]]}] [data [number - ["." frac]] + ["." int] + ["f" frac]] [collection ["." list ("#@." functor)]]] ["." math @@ -23,19 +24,19 @@ (def: (within? margin standard value) (-> Frac Complex Complex Bit) - (let [real-dist (frac.abs (f/- (get@ #/.real standard) - (get@ #/.real value))) - imgn-dist (frac.abs (f/- (get@ #/.imaginary standard) - (get@ #/.imaginary value)))] - (and (f/< margin real-dist) - (f/< margin imgn-dist)))) + (let [real-dist (f.abs (f.- (get@ #/.real standard) + (get@ #/.real value))) + imgn-dist (f.abs (f.- (get@ #/.imaginary standard) + (get@ #/.imaginary value)))] + (and (f.< margin real-dist) + (f.< margin imgn-dist)))) (def: dimension (Random Frac) (do r.monad [factor (|> r.nat (:: @ map (|>> (n/% 1000) (n/max 1)))) - measure (|> r.safe-frac (r.filter (f/> +0.0)))] - (wrap (f/* (|> factor .int int-to-frac) + measure (|> r.safe-frac (r.filter (f.> +0.0)))] + (wrap (f.* (|> factor .int int.frac) measure)))) (def: #export complex @@ -53,11 +54,11 @@ ($_ _.and (_.test "Can build and tear apart complex numbers" (let [r+i (/.complex real imaginary)] - (and (f/= real (get@ #/.real r+i)) - (f/= imaginary (get@ #/.imaginary r+i))))) + (and (f.= real (get@ #/.real r+i)) + (f.= imaginary (get@ #/.imaginary r+i))))) (_.test "If either the real part or the imaginary part is NaN, the composite is NaN." - (and (/.not-a-number? (/.complex frac.not-a-number imaginary)) - (/.not-a-number? (/.complex real frac.not-a-number)))) + (and (/.not-a-number? (/.complex f.not-a-number imaginary)) + (/.not-a-number? (/.complex real f.not-a-number)))) ))) (def: absolute-value @@ -69,16 +70,16 @@ (_.test "Absolute value of complex >= absolute value of any of the parts." (let [r+i (/.complex real imaginary) abs (get@ #/.real (/.abs r+i))] - (and (f/>= (frac.abs real) abs) - (f/>= (frac.abs imaginary) abs)))) + (and (f.>= (f.abs real) abs) + (f.>= (f.abs imaginary) abs)))) (_.test "The absolute value of a complex number involving a NaN on either dimension, results in a NaN value." - (and (frac.not-a-number? (get@ #/.real (/.abs (/.complex frac.not-a-number imaginary)))) - (frac.not-a-number? (get@ #/.real (/.abs (/.complex real frac.not-a-number)))))) + (and (f.not-a-number? (get@ #/.real (/.abs (/.complex f.not-a-number imaginary)))) + (f.not-a-number? (get@ #/.real (/.abs (/.complex real f.not-a-number)))))) (_.test "The absolute value of a complex number involving an infinity on either dimension, results in an infinite value." - (and (f/= frac.positive-infinity (get@ #/.real (/.abs (/.complex frac.positive-infinity imaginary)))) - (f/= frac.positive-infinity (get@ #/.real (/.abs (/.complex real frac.positive-infinity)))) - (f/= frac.positive-infinity (get@ #/.real (/.abs (/.complex frac.negative-infinity imaginary)))) - (f/= frac.positive-infinity (get@ #/.real (/.abs (/.complex real frac.negative-infinity)))))) + (and (f.= f.positive-infinity (get@ #/.real (/.abs (/.complex f.positive-infinity imaginary)))) + (f.= f.positive-infinity (get@ #/.real (/.abs (/.complex real f.positive-infinity)))) + (f.= f.positive-infinity (get@ #/.real (/.abs (/.complex f.negative-infinity imaginary)))) + (f.= f.positive-infinity (get@ #/.real (/.abs (/.complex real f.negative-infinity)))))) ))) (def: number @@ -91,16 +92,16 @@ (_.test "Adding 2 complex numbers is the same as adding their parts." (let [z (/.+ y x)] (and (/.= z - (/.complex (f/+ (get@ #/.real y) + (/.complex (f.+ (get@ #/.real y) (get@ #/.real x)) - (f/+ (get@ #/.imaginary y) + (f.+ (get@ #/.imaginary y) (get@ #/.imaginary x))))))) (_.test "Subtracting 2 complex numbers is the same as adding their parts." (let [z (/.- y x)] (and (/.= z - (/.complex (f/- (get@ #/.real y) + (/.complex (f.- (get@ #/.real y) (get@ #/.real x)) - (f/- (get@ #/.imaginary y) + (f.- (get@ #/.imaginary y) (get@ #/.imaginary x))))))) (_.test "Subtraction is the inverse of addition." (and (|> x (/.+ y) (/.- y) (within? margin-of-error x)) @@ -127,9 +128,9 @@ ($_ _.and (_.test "Conjugate has same real part as original, and opposite of imaginary part." (let [cx (/.conjugate x)] - (and (f/= (get@ #/.real x) + (and (f.= (get@ #/.real x) (get@ #/.real cx)) - (f/= (frac.negate (get@ #/.imaginary x)) + (f.= (f.negate (get@ #/.imaginary x)) (get@ #/.imaginary cx))))) (_.test "The reciprocal functions is its own inverse." (|> x /.reciprocal /.reciprocal (within? margin-of-error x))) @@ -137,16 +138,16 @@ (|> x (/.* (/.reciprocal x)) (within? margin-of-error /.one))) (_.test "Absolute value of signum is always root2(2), 1 or 0." (let [signum-abs (|> x /.signum /.abs (get@ #/.real))] - (or (f/= +0.0 signum-abs) - (f/= +1.0 signum-abs) - (f/= (math.pow +0.5 +2.0) signum-abs)))) + (or (f.= +0.0 signum-abs) + (f.= +1.0 signum-abs) + (f.= (math.pow +0.5 +2.0) signum-abs)))) (_.test "Negation is its own inverse." (let [there (/.negate x) back-again (/.negate there)] (and (not (/.= there x)) (/.= back-again x)))) (_.test "Negation doesn't change the absolute value." - (f/= (get@ #/.real (/.abs x)) + (f.= (get@ #/.real (/.abs x)) (get@ #/.real (/.abs (/.negate x))))) ))) @@ -158,8 +159,8 @@ (def: trigonometry Test (do r.monad - [angle (|> ..complex (:: @ map (|>> (update@ #/.real (f/% +1.0)) - (update@ #/.imaginary (f/% +1.0)))))] + [angle (|> ..complex (:: @ map (|>> (update@ #/.real (f.% +1.0)) + (update@ #/.imaginary (f.% +1.0)))))] ($_ _.and (_.test "Arc-sine is the inverse of sine." (trigonometric-symmetry /.sin /.asin angle)) @@ -187,7 +188,7 @@ (_.test "Can calculate the N roots for any complex number." (|> sample (/.roots degree) - (list@map (/.pow' (|> degree .int int-to-frac))) + (list@map (/.pow' (|> degree .int int.frac))) (list.every? (within? margin-of-error sample)))))) (def: #export test diff --git a/stdlib/source/test/lux/data/number/frac.lux b/stdlib/source/test/lux/data/number/frac.lux index 736f82457..257d4c049 100644 --- a/stdlib/source/test/lux/data/number/frac.lux +++ b/stdlib/source/test/lux/data/number/frac.lux @@ -14,11 +14,12 @@ ["r" random]]] {1 ["." / - //]}) + [// #* + ["." int]]]}) (def: #export test Test - (let [gen-frac (:: r.monad map (|>> (i/% +100) .int-to-frac) r.int)] + (let [gen-frac (:: r.monad map (|>> (i/% +100) int.frac) r.int)] (<| (_.context (%.name (name-of /._))) (`` ($_ _.and ($equivalence.spec /.equivalence gen-frac) @@ -38,15 +39,15 @@ ## )) (_.test "Alternate notations." - (and (f/= (bin "+1100.1001") + (and (/.= (bin "+1100.1001") (bin "+11,00.10,01")) - (f/= (oct "-6152.43") + (/.= (oct "-6152.43") (oct "-615,2.43")) - (f/= (hex "+deadBE.EF") + (/.= (hex "+deadBE.EF") (hex "+dead,BE.EF")))) (do r.monad [sample gen-frac] (_.test (format (%.name (name-of /.to-bits)) " & " (%.name (name-of /.from-bits))) - (|> sample /.to-bits /.from-bits (f/= sample)))) + (|> sample /.to-bits /.from-bits (/.= sample)))) ))))) diff --git a/stdlib/source/test/lux/macro/code.lux b/stdlib/source/test/lux/macro/code.lux index f395c5509..e0bcd9df4 100644 --- a/stdlib/source/test/lux/macro/code.lux +++ b/stdlib/source/test/lux/macro/code.lux @@ -5,7 +5,10 @@ ["r" math/random (#+ Random)] ["_" test (#+ Test)] [data - ["." text ("#@." equivalence)]]] + ["." text ("#@." equivalence)] + [number + ["." int] + ["f" frac]]]] {1 ["." /]}) @@ -21,9 +24,9 @@ below (:: @ map (i/% +100) r.int) #let [frac (|> below (i// +100) - .int-to-frac - (f/+ (.int-to-frac above)) - (f/* -1.0))] + int.frac + (f.+ (int.frac above)) + (f.* -1.0))] text (r.ascii 10) short (r.ascii/alpha 10) module (r.ascii/alpha 10) diff --git a/stdlib/source/test/lux/math.lux b/stdlib/source/test/lux/math.lux index 46b5171ee..ffe990c50 100644 --- a/stdlib/source/test/lux/math.lux +++ b/stdlib/source/test/lux/math.lux @@ -7,7 +7,8 @@ [data ["." bit ("#@." equivalence)] [number - ["." frac]]]] + ["." int] + ["f" frac]]]] {1 ["." /]} ["." / #_ @@ -19,8 +20,8 @@ (def: (within? margin-of-error standard value) (-> Frac Frac Frac Bit) - (f/< margin-of-error - (frac.abs (f/- standard value)))) + (f.< margin-of-error + (f.abs (f.- standard value)))) (def: margin Frac +0.0000001) @@ -35,7 +36,7 @@ ($_ _.and (<| (_.context "Trigonometry") (do r.monad - [angle (|> r.safe-frac (:: @ map (f/* /.tau)))] + [angle (|> r.safe-frac (:: @ map (f.* /.tau)))] ($_ _.and (_.test "Sine and arc-sine are inverse functions." (trigonometric-symmetry /.sin /.asin angle)) @@ -46,26 +47,26 @@ ))) (<| (_.context "Rounding") (do r.monad - [sample (|> r.safe-frac (:: @ map (f/* +1000.0)))] + [sample (|> r.safe-frac (:: @ map (f.* +1000.0)))] ($_ _.and (_.test "The ceiling will be an integer value, and will be >= the original." (let [ceil'd (/.ceil sample)] - (and (|> ceil'd frac-to-int int-to-frac (f/= ceil'd)) - (f/>= sample ceil'd) - (f/<= +1.0 (f/- sample ceil'd))))) + (and (|> ceil'd f.int int.frac (f.= ceil'd)) + (f.>= sample ceil'd) + (f.<= +1.0 (f.- sample ceil'd))))) (_.test "The floor will be an integer value, and will be <= the original." (let [floor'd (/.floor sample)] - (and (|> floor'd frac-to-int int-to-frac (f/= floor'd)) - (f/<= sample floor'd) - (f/<= +1.0 (f/- floor'd sample))))) + (and (|> floor'd f.int int.frac (f.= floor'd)) + (f.<= sample floor'd) + (f.<= +1.0 (f.- floor'd sample))))) (_.test "The round will be an integer value, and will be < or > or = the original." (let [round'd (/.round sample)] - (and (|> round'd frac-to-int int-to-frac (f/= round'd)) - (f/<= +1.0 (frac.abs (f/- sample round'd)))))) + (and (|> round'd f.int int.frac (f.= round'd)) + (f.<= +1.0 (f.abs (f.- sample round'd)))))) ))) (<| (_.context "Exponentials and logarithms") (do r.monad - [sample (|> r.safe-frac (:: @ map (f/* +10.0)))] + [sample (|> r.safe-frac (:: @ map (f.* +10.0)))] (_.test "Logarithm is the inverse of exponential." (|> sample /.exp /.log (within? +0.000000000000001 sample))))) (<| (_.context "Greatest-Common-Divisor and Least-Common-Multiple") diff --git a/stdlib/source/test/lux/math/infix.lux b/stdlib/source/test/lux/math/infix.lux index bbad48621..e2850f549 100644 --- a/stdlib/source/test/lux/math/infix.lux +++ b/stdlib/source/test/lux/math/infix.lux @@ -5,7 +5,9 @@ ["r" math/random] ["_" test (#+ Test)] [data - ["." bit ("#@." equivalence)]]] + ["." bit ("#@." equivalence)] + [number + ["f" frac]]]] {1 ["." / ["." //]]}) @@ -26,7 +28,7 @@ (n/= (//.n/gcd parameter subject) (/.infix [subject //.n/gcd parameter]))) (_.test "Can call unary functions." - (f/= (//.sin angle) + (f.= (//.sin angle) (/.infix [//.sin angle]))) (_.test "Can use regular syntax in the middle of infix code." (n/= (//.n/gcd extra (n/* parameter subject)) diff --git a/stdlib/source/test/lux/math/modular.lux b/stdlib/source/test/lux/math/modular.lux index a600acfab..8a2ba754d 100644 --- a/stdlib/source/test/lux/math/modular.lux +++ b/stdlib/source/test/lux/math/modular.lux @@ -56,7 +56,7 @@ (|> (i/! (value param) (value subject)) (/.mod modulus) - (/.m/= (m/! param subject))))) + (/.= (m/! param subject))))) (def: #export test Test @@ -81,30 +81,30 @@ (i/= _normalM (/.to-int normalM))) (_.test "Can compare mod'ed values." - (and (/.m/= subject subject) - ((comparison /.m/= i/=) param subject) - ((comparison /.m/< i/<) param subject) - ((comparison /.m/<= i/<=) param subject) - ((comparison /.m/> i/>) param subject) - ((comparison /.m/>= i/>=) param subject))) + (and (/.= subject subject) + ((comparison /.= i/=) param subject) + ((comparison /.< i/<) param subject) + ((comparison /.<= i/<=) param subject) + ((comparison /.> i/>) param subject) + ((comparison /.>= i/>=) param subject))) (_.test "Mod'ed values are ordered." - (and (bit@= (/.m/< param subject) - (not (/.m/>= param subject))) - (bit@= (/.m/> param subject) - (not (/.m/<= param subject))) - (bit@= (/.m/= param subject) - (not (or (/.m/< param subject) - (/.m/> param subject)))))) + (and (bit@= (/.< param subject) + (not (/.>= param subject))) + (bit@= (/.> param subject) + (not (/.<= param subject))) + (bit@= (/.= param subject) + (not (or (/.< param subject) + (/.> param subject)))))) (_.test "Can do arithmetic." - (and ((arithmetic normalM /.m/+ i/+) param subject) - ((arithmetic normalM /.m/- i/-) param subject) - ((arithmetic normalM /.m/* i/*) param subject))) + (and ((arithmetic normalM /.+ i/+) param subject) + ((arithmetic normalM /.- i/-) param subject) + ((arithmetic normalM /.* i/*) param subject))) (_.test "Can sometimes find multiplicative inverse." (case (/.inverse subject) (#.Some subject^-1) (|> subject - (/.m/* subject^-1) - (/.m/= (/.mod normalM +1))) + (/.* subject^-1) + (/.= (/.mod normalM +1))) #.None true)) @@ -112,7 +112,7 @@ (let [(^open "mod/.") (/.codec normalM)] (case (|> subject mod/encode mod/decode) (#try.Success output) - (/.m/= subject output) + (/.= subject output) (#try.Failure error) false))) @@ -120,7 +120,7 @@ (case (/.equalize (/.mod normalM _subject) (/.mod copyM _param)) (#try.Success paramC) - (/.m/= param paramC) + (/.= param paramC) (#try.Failure error) false)) @@ -136,5 +136,5 @@ (/.congruent? normalM _subject _subject)) (_.test "If 2 numbers are congruent under a modulus, then they must also be equal under the same modulus." (bit@= (/.congruent? normalM _param _subject) - (/.m/= param subject))) + (/.= param subject))) )))) |