diff options
Diffstat (limited to 'stdlib')
32 files changed, 564 insertions, 565 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 7a49fb2ec..d29e4fca5 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -25,9 +25,9 @@ (+1 [["lux" "doc"] (+5 "Your standard, run-of-the-mill integer numbers.")] (+0))))) -(_lux_def Real - (+12 ["lux" "Real"] - (+0 "#Real" (+0))) +(_lux_def Frac + (+12 ["lux" "Frac"] + (+0 "#Frac" (+0))) (+1 [["lux" "type?"] (+0 true)] (+1 [["lux" "export?"] (+0 true)] (+1 [["lux" "doc"] (+5 "Your standard, run-of-the-mill floating-point numbers.")] @@ -212,7 +212,7 @@ ## (#NatA Nat) ## (#IntA Int) ## (#DegA Deg) -## (#RealA Real) +## (#FracA Frac) ## (#TextA Text) ## (#IdentA Ident) ## (#ListA (List Ann-Value)) @@ -231,8 +231,8 @@ Int (#Sum ## #DegA Deg - (#Sum ## #RealA - Real + (#Sum ## #FracA + Frac (#Sum ## #TextA Text (#Sum ## #IdentA @@ -249,7 +249,7 @@ (#Cons (+5 "NatA") (#Cons (+5 "IntA") (#Cons (+5 "DegA") - (#Cons (+5 "RealA") + (#Cons (+5 "FracA") (#Cons (+5 "TextA") (#Cons (+5 "IdentA") (#Cons (+5 "ListA") @@ -380,7 +380,7 @@ ## (#Nat Nat) ## (#Int Int) ## (#Deg Deg) -## (#Real Real) +## (#Frac Frac) ## (#Text Text) ## (#Symbol Text Text) ## (#Tag Text Text) @@ -404,8 +404,8 @@ Int (#Sum ## "lux;Deg" Deg - (#Sum ## "lux;Real" - Real + (#Sum ## "lux;Frac" + Frac (#Sum ## "lux;Text" Text (#Sum ## "lux;Symbol" @@ -424,7 +424,7 @@ (#Cons (#TextA "Nat") (#Cons (#TextA "Int") (#Cons (#TextA "Deg") - (#Cons (#TextA "Real") + (#Cons (#TextA "Frac") (#Cons (#TextA "Text") (#Cons (#TextA "Symbol") (#Cons (#TextA "Tag") @@ -732,9 +732,9 @@ (_lux_function _ value (_meta (#Deg value)))) #Nil) -(_lux_def real$ - (_lux_: (#Function Real Code) - (_lux_function _ value (_meta (#Real value)))) +(_lux_def frac$ + (_lux_: (#Function Frac Code) + (_lux_function _ value (_meta (#Frac value)))) #Nil) (_lux_def text$ @@ -1778,8 +1778,8 @@ [_ [_ (#Deg value)]] (return (wrap-meta (form$ (list (tag$ ["lux" "Deg"]) (deg$ value))))) - [_ [_ (#Real value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Real"]) (real$ value))))) + [_ [_ (#Frac value)]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Frac"]) (frac$ value))))) [_ [_ (#Text value)]] (return (wrap-meta (form$ (list (tag$ ["lux" "Text"]) (text$ value))))) @@ -2121,16 +2121,16 @@ (_lux_proc [<category> "="] [subject test])))] [ Nat "nat" n.= n.< n.<= n.> n.>= - "Natural equality." "Natural less-than." "Natural less-than-equal." "Natural greater-than." "Natural greater-than-equal."] + "Nat(ural) equality." "Nat(ural) less-than." "Nat(ural) less-than-equal." "Nat(ural) greater-than." "Nat(ural) greater-than-equal."] [ Int "int" i.= i.< i.<= i.> i.>= - "Integer equality." "Integer less-than." "Integer less-than-equal." "Integer greater-than." "Integer greater-than-equal."] + "Int(eger) equality." "Int(eger) less-than." "Int(eger) less-than-equal." "Int(eger) greater-than." "Int(eger) greater-than-equal."] [ Deg "deg" d.= d.< d.<= d.> d.>= - "Degree equality." "Degree less-than." "Degree less-than-equal." "Degree greater-than." "Degree greater-than-equal."] + "Deg(ree) equality." "Deg(ree) less-than." "Deg(ree) less-than-equal." "Deg(ree) greater-than." "Deg(ree) greater-than-equal."] - [Real "real" r.= r.< r.<= r.> r.>= - "Real equality." "Real less-than." "Real less-than-equal." "Real greater-than." "Real greater-than-equal."] + [Frac "frac" f.= f.< f.<= f.> f.>= + "Frac(tion) equality." "Frac(tion) less-than." "Frac(tion) less-than-equal." "Frac(tion) greater-than." "Frac(tion) greater-than-equal."] ) (do-template [<type> <name> <op> <doc>] @@ -2157,11 +2157,11 @@ [ Deg d./ [ "deg" "/"] "Deg(ree) division."] [ Deg d.% [ "deg" "%"] "Deg(ree) remainder."] - [Real r.+ ["real" "+"] "Real addition."] - [Real r.- ["real" "-"] "Real substraction."] - [Real r.* ["real" "*"] "Real multiplication."] - [Real r./ ["real" "/"] "Real division."] - [Real r.% ["real" "%"] "Real remainder."] + [Frac f.+ ["frac" "+"] "Frac(tion) addition."] + [Frac f.- ["frac" "-"] "Frac(tion) substraction."] + [Frac f.* ["frac" "*"] "Frac(tion) multiplication."] + [Frac f./ ["frac" "/"] "Frac(tion) division."] + [Frac f.% ["frac" "%"] "Frac(tion) remainder."] ) (do-template [<type> <name> <op> <doc>] @@ -2191,8 +2191,8 @@ [d.min Deg d.< "Deg(ree) minimum."] [d.max Deg d.> "Deg(ree) maximum."] - [r.min Real r.< "Real minimum."] - [r.max Real r.> "Real minimum."] + [f.min Frac f.< "Frac minimum."] + [f.max Frac f.> "Frac minimum."] ) (def:''' (Bool/encode x) @@ -2252,10 +2252,10 @@ (|> value (i./ 10) Int/abs) (|> value (i.% 10) Int/abs (_lux_:! Nat) digit-to-text))))) -(def:''' (Real/encode x) +(def:''' (Frac/encode x) #Nil - (-> Real Text) - (_lux_proc ["real" "encode"] [x])) + (-> Frac Text) + (_lux_proc ["frac" "encode"] [x])) (def:''' (multiple? div n) #Nil @@ -2686,8 +2686,8 @@ [_ (#Deg value)] (_lux_proc ["io" "error"] ["Undefined behavior."]) - [_ (#Real value)] - (Real/encode value) + [_ (#Frac value)] + (Frac/encode value) [_ (#Text value)] ($_ Text/append "\"" value "\"") @@ -2916,8 +2916,8 @@ [_ (#Deg value)] (return (form$ (list (tag$ ["lux" "DegA"]) (deg$ value)))) - [_ (#Real value)] - (return (form$ (list (tag$ ["lux" "RealA"]) (real$ value)))) + [_ (#Frac value)] + (return (form$ (list (tag$ ["lux" "FracA"]) (frac$ value)))) [_ (#Text value)] (return (form$ (list (tag$ ["lux" "TextA"]) (text$ value)))) @@ -4877,8 +4877,8 @@ (-> <from> <to>) (_lux_proc <proc> [n]))] - [real-to-int Real Int ["real" "to-int"]] - [int-to-real Int Real ["int" "to-real"]] + [frac-to-int Frac Int ["frac" "to-int"]] + [int-to-frac Int Frac ["int" "to-frac"]] ) (def: (find-baseline-column ast) @@ -4891,7 +4891,7 @@ [#Nat] [#Int] [#Deg] - [#Real] + [#Frac] [#Text] [#Symbol] [#Tag]) @@ -4958,8 +4958,8 @@ [int-to-nat ["int" "to-nat"] Int Nat] [nat-to-int ["nat" "to-int"] Nat Int] - [real-to-deg ["real" "to-deg"] Real Deg] - [deg-to-real ["deg" "to-real"] Deg Real] + [frac-to-deg ["frac" "to-deg"] Frac Deg] + [deg-to-frac ["deg" "to-frac"] Deg Frac] ) (def: (repeat n x) @@ -5008,7 +5008,7 @@ ([#Bool Bool/encode] [#Nat Nat/encode] [#Int Int/encode] - [#Real Real/encode] + [#Frac Frac/encode] [#Text Text/encode] [#Symbol Ident/encode] [#Tag Tag/encode]) @@ -5208,7 +5208,7 @@ (def: (place-tokens label tokens target) (-> Text (List Code) Code (Maybe (List Code))) (case target - (^or [_ (#Bool _)] [_ (#Nat _)] [_ (#Int _)] [_ (#Deg _)] [_ (#Real _)] [_ (#Text _)] [_ (#Tag _)]) + (^or [_ (#Bool _)] [_ (#Nat _)] [_ (#Int _)] [_ (#Deg _)] [_ (#Frac _)] [_ (#Text _)] [_ (#Tag _)]) (#Some (list target)) [_ (#Symbol [prefix name])] @@ -5257,7 +5257,7 @@ [(bool true) "true" [_ (#;Bool true)]] [(bool false) "false" [_ (#;Bool false)]] [(int 123) "123" [_ (#;Int 123)]] - [(real 123.0) "123.0" [_ (#;Real 123.0)]] + [(frac 123.0) "123.0" [_ (#;Frac 123.0)]] [(text "\n") "\"\\n\"" [_ (#;Text "\n")]] [(tag ["yolo" "lol"]) "#yolo;lol" [_ (#;Tag ["yolo" "lol"])]] [(symbol ["yolo" "lol"]) "yolo;lol" [_ (#;Symbol ["yolo" "lol"])]] @@ -5302,7 +5302,7 @@ ["Nat"] ["Int"] ["Deg"] - ["Real"] + ["Frac"] ["Text"]) (#Named _ type') @@ -5324,7 +5324,7 @@ ["Nat" Nat nat$] ["Int" Int int$] ["Deg" Deg deg$] - ["Real" Real real$] + ["Frac" Frac frac$] ["Text" Text text$]) _ @@ -5362,7 +5362,7 @@ )) (macro: #export (^~ tokens) - {#;doc (doc "Use global defs with simple values, such as text, int, real and bool in place of literals in patterns." + {#;doc (doc "Use global defs with simple values, such as text, int, frac and bool in place of literals in patterns." "The definitions must be properly-qualified (though you may use one of the short-cuts Lux provides)." (def: (empty?' node) (All [K V] (-> (Node K V) Bool)) diff --git a/stdlib/source/lux/control/concatenative.lux b/stdlib/source/lux/control/concatenative.lux index a0854ffcf..61a6ddbd0 100644 --- a/stdlib/source/lux/control/concatenative.lux +++ b/stdlib/source/lux/control/concatenative.lux @@ -2,7 +2,7 @@ n.+ n.- n.* n./ n.% n.= n.< n.<= n.> n.>= i.+ i.- i.* i./ i.% i.= i.< i.<= i.> i.>= d.+ d.- d.* d./ d.% d.= d.< d.<= d.> d.>= - r.+ r.- r.* r./ r.% r.= r.< r.<= r.> r.>=] + f.+ f.- f.* f./ f.% f.= f.< f.<= f.> f.>=] (lux (control ["p" parser "p/" Monad<Parser>] [monad]) (data [text] @@ -98,7 +98,7 @@ (case command (^or [_ (#;Bool _)] [_ (#;Nat _)] [_ (#;Int _)] - [_ (#;Deg _)] [_ (#;Real _)] + [_ (#;Deg _)] [_ (#;Frac _)] [_ (#;Text _)] [_ (#;Tag _)] (^ [_ (#;Form (list [_ (#;Tag _)]))])) (` (;;push (~ command))) @@ -231,16 +231,16 @@ [Deg Bool d.> ;d.>] [Deg Bool d.>= ;d.>=] - [Real Real r.+ ;r.+] - [Real Real r.- ;r.-] - [Real Real r.* ;r.*] - [Real Real r./ ;r./] - [Real Real r.% ;r.%] - [Real Bool r.= ;r.=] - [Real Bool r.< ;r.<] - [Real Bool r.<= ;r.<=] - [Real Bool r.> ;r.>] - [Real Bool r.>= ;r.>=] + [Frac Frac f.+ ;f.+] + [Frac Frac f.- ;f.-] + [Frac Frac f.* ;f.*] + [Frac Frac f./ ;f./] + [Frac Frac f.% ;f.%] + [Frac Bool f.= ;f.=] + [Frac Bool f.< ;f.<] + [Frac Bool f.<= ;f.<=] + [Frac Bool f.> ;f.>] + [Frac Bool f.>= ;f.>=] ) (def: #export if diff --git a/stdlib/source/lux/data/color.lux b/stdlib/source/lux/data/color.lux index f4799726f..61ee1249a 100644 --- a/stdlib/source/lux/data/color.lux +++ b/stdlib/source/lux/data/color.lux @@ -8,18 +8,18 @@ (def: rgb Nat +256) (def: top Nat (n.dec rgb)) -(def: nat-to-real (-> Nat Real) (|>. nat-to-int int-to-real)) -(def: real-to-nat (-> Real Nat) (|>. real-to-int int-to-nat)) +(def: nat-to-frac (-> Nat Frac) (|>. nat-to-int int-to-frac)) +(def: frac-to-nat (-> Frac Nat) (|>. frac-to-int int-to-nat)) -(def: rgb-factor Real (nat-to-real top)) +(def: rgb-factor Frac (nat-to-frac top)) (def: scale-down - (-> Nat Real) - (|>. nat-to-real (r./ rgb-factor))) + (-> Nat Frac) + (|>. nat-to-frac (f./ rgb-factor))) (def: scale-up - (-> Real Nat) - (|>. (r.* rgb-factor) real-to-nat)) + (-> Frac Nat) + (|>. (f.* rgb-factor) frac-to-nat)) (opaque: #export Color {} {#red Nat @@ -46,115 +46,115 @@ ) (def: #export (to-hsl color) - (-> Color [Real Real Real]) + (-> Color [Frac Frac Frac]) (let [[red green blue] (unpack color) red (scale-down red) green (scale-down green) blue (scale-down blue) - max ($_ r.max red green blue) - min ($_ r.min red green blue) - luminance (|> (r.+ max min) (r./ 2.0))] - (if (r.= 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 (r.- min)) + (let [diff (|> max (f.- min)) saturation (|> diff - (r./ (if (r.> 0.5 luminance) - (|> 2.0 (r.- max) (r.- min)) - (|> max (r.+ min))))) - hue' (cond (r.= red max) - (|> green (r.- blue) (r./ diff) - (r.+ (if (r.< 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))) - (r.= green max) - (|> blue (r.- red) (r./ diff) - (r.+ 2.0)) + (f.= green max) + (|> blue (f.- red) (f./ diff) + (f.+ 2.0)) - ## (r.= blue max) - (|> red (r.- green) (r./ diff) - (r.+ 4.0)))] - [(|> hue' (r./ 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) - (-> Real Real Real Real) - (let [t (cond (r.< 0.0 t) (r.+ 1.0 t) - (r.> 1.0 t) (r.- 1.0 t) + (-> Frac Frac Frac Frac) + (let [t (cond (f.< 0.0 t) (f.+ 1.0 t) + (f.> 1.0 t) (f.- 1.0 t) ## else t) - f2/3 (r./ 3.0 2.0)] - (cond (r.< (r./ 6.0 1.0) t) - (|> q (r.- p) (r.* 6.0) (r.* t) (r.+ 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)) - (r.< (r./ 2.0 1.0) t) + (f.< (f./ 2.0 1.0) t) q - (r.< f2/3 t) - (|> q (r.- p) (r.* (|> f2/3 (r.- t))) (r.* 6.0) (r.+ 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]) - (-> [Real Real Real] Color) - (if (r.= 0.0 saturation) + (-> [Frac Frac Frac] Color) + (if (f.= 0.0 saturation) ## Achromatic (let [intensity (scale-up luminance)] (color [intensity intensity intensity])) ## Chromatic - (let [q (if (r.< 0.5 luminance) - (|> saturation (r.+ 1.0) (r.* luminance)) - (|> luminance (r.+ saturation) (r.- (r.* saturation luminance)))) - p (|> luminance (r.* 2.0) (r.- q)) - third (|> 1.0 (r./ 3.0))] - (color [(scale-up (|> hue (r.+ 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))] + (color [(scale-up (|> hue (f.+ third) (hue-to-rgb p q))) (scale-up (|> hue (hue-to-rgb p q))) - (scale-up (|> hue (r.- third) (hue-to-rgb p q)))])))) + (scale-up (|> hue (f.- third) (hue-to-rgb p q)))])))) (def: #export (to-hsb color) - (-> Color [Real Real Real]) + (-> Color [Frac Frac Frac]) (let [[red green blue] (unpack color) red (scale-down red) green (scale-down green) blue (scale-down blue) - max ($_ r.max red green blue) - min ($_ r.min red green blue) + max ($_ f.max red green blue) + min ($_ f.min red green blue) brightness max - diff (|> max (r.- min)) - saturation (if (r.= 0.0 max) + diff (|> max (f.- min)) + saturation (if (f.= 0.0 max) 0.0 - (|> diff (r./ max)))] - (if (r.= max min) + (|> diff (f./ max)))] + (if (f.= max min) ## Achromatic [0.0 saturation brightness] ## Chromatic - (let [hue (cond (r.= red max) - (|> green (r.- blue) (r./ diff) - (r.+ (if (r.< blue green) 6.0 0.0))) - - (r.= green max) - (|> blue (r.- red) (r./ diff) - (r.+ 2.0)) - - ## (r.= blue max) - (|> red (r.- green) (r./ diff) - (r.+ 4.0)))] - [(|> hue (r./ 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]) - (-> [Real Real Real] Color) - (let [hue (|> hue (r.* 6.0)) + (-> [Frac Frac Frac] Color) + (let [hue (|> hue (f.* 6.0)) i (math;floor hue) - f (|> hue (r.- i)) - p (|> 1.0 (r.- saturation) (r.* brightness)) - q (|> 1.0 (r.- (r.* f saturation)) (r.* brightness)) - t (|> 1.0 (r.- (|> 1.0 (r.- f) (r.* saturation))) (r.* 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 (r.% 6.0) real-to-nat) + mod (|> i (f.% 6.0) frac-to-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))] @@ -163,51 +163,51 @@ (scale-up blue)]))) (def: #export (to-cmyk color) - (-> Color [Real Real Real Real]) + (-> Color [Frac Frac Frac Frac]) (let [[red green blue] (unpack color) red (scale-down red) green (scale-down green) blue (scale-down blue) - key (|> 1.0 (r.- ($_ r.max red green blue))) - f (if (r.< 1.0 key) - (|> 1.0 (r./ (|> 1.0 (r.- 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 (r.- red) (r.- key) (r.* f)) - magenta (|> 1.0 (r.- green) (r.- key) (r.* f)) - yellow (|> 1.0 (r.- blue) (r.- key) (r.* 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 magenta yellow key])) (def: #export (from-cmyk [cyan magenta yellow key]) - (-> [Real Real Real Real] Color) - (if (r.= 1.0 key) + (-> [Frac Frac Frac Frac] Color) + (if (f.= 1.0 key) (color [+0 +0 +0]) - (let [red (|> (|> 1.0 (r.- cyan)) - (r.* (|> 1.0 (r.- key)))) - green (|> (|> 1.0 (r.- magenta)) - (r.* (|> 1.0 (r.- key)))) - blue (|> (|> 1.0 (r.- yellow)) - (r.* (|> 1.0 (r.- 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))))] (color [(scale-up red) (scale-up green) (scale-up blue)])))) (def: (normalize ratio) - (-> Real Real) - (cond (r.> 1.0 ratio) - (r.% 1.0 ratio) + (-> Frac Frac) + (cond (f.> 1.0 ratio) + (f.% 1.0 ratio) - (r.< 0.0 ratio) - (|> 1.0 (r.+ (r.% 1.0 ratio))) + (f.< 0.0 ratio) + (|> 1.0 (f.+ (f.% 1.0 ratio))) ## else ratio)) (def: #export (interpolate ratio end start) - (-> Real Color Color Color) + (-> Frac Color Color Color) (let [dS (normalize ratio) - dE (|> 1.0 (r.- dS)) + dE (|> 1.0 (f.- dS)) interpolate' (: (-> Nat Nat Nat) (function [end start] - (real-to-nat (r.+ (r.* dE (nat-to-real end)) - (r.* dS (nat-to-real start)))))) + (frac-to-nat (f.+ (f.* dE (nat-to-frac end)) + (f.* dS (nat-to-frac start)))))) [redS greenS blueS] (unpack start) [redE greenE blueE] (unpack end)] (color [(interpolate' redE redS) @@ -219,7 +219,7 @@ (do-template [<name> <target>] [(def: #export (<name> ratio color) - (-> Real Color Color) + (-> Frac Color Color) (interpolate ratio <target> color))] [darker black] @@ -236,16 +236,16 @@ (do-template [<name> <op>] [(def: #export (<name> ratio color) - (-> Real Color Color) + (-> Frac Color Color) (let [[hue saturation luminance] (to-hsl color)] (from-hsl [hue (|> saturation - (r.* (|> 1.0 (<op> (normalize ratio)))) - (r.min 1.0)) + (f.* (|> 1.0 (<op> (normalize ratio)))) + (f.min 1.0)) luminance])))] - [saturate r.+] - [de-saturate r.-] + [saturate f.+] + [de-saturate f.-] ) (def: #export (gray-scale color) @@ -258,12 +258,12 @@ (-> Color [Color Color Color]) (let [[hue saturation luminance] (to-hsl color)] [color - (from-hsl [(|> hue (r.+ <1>) normalize) saturation luminance]) - (from-hsl [(|> hue (r.+ <2>) normalize) saturation luminance])]))] + (from-hsl [(|> hue (f.+ <1>) normalize) saturation luminance]) + (from-hsl [(|> hue (f.+ <2>) normalize) saturation luminance])]))] - [triad (|> 1.0 (r./ 3.0)) (|> 2.0 (r./ 3.0))] - [clash (|> 1.0 (r./ 4.0)) (|> 3.0 (r./ 4.0))] - [split-complement (|> 1.0 (r./ 5.0)) (|> 3.0 (r./ 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))] ) (do-template [<name> <1> <2> <3>] @@ -271,22 +271,22 @@ (-> Color [Color Color Color Color]) (let [[hue saturation luminance] (to-hsl color)] [color - (from-hsl [(|> hue (r.+ <1>) normalize) saturation luminance]) - (from-hsl [(|> hue (r.+ <2>) normalize) saturation luminance]) - (from-hsl [(|> hue (r.+ <3>) normalize) saturation luminance])]))] + (from-hsl [(|> hue (f.+ <1>) normalize) saturation luminance]) + (from-hsl [(|> hue (f.+ <2>) normalize) saturation luminance]) + (from-hsl [(|> hue (f.+ <3>) normalize) saturation luminance])]))] - [square (|> 1.0 (r./ 4.0)) (|> 2.0 (r./ 4.0)) (|> 3.0 (r./ 4.0))] - [tetradic (|> 2.0 (r./ 12.0)) (|> 6.0 (r./ 12.0)) (|> 8.0 (r./ 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) - (-> Nat Real Color (List Color)) + (-> Nat Frac Color (List Color)) (if (n.= +0 results) (list) (let [[hue saturation luminance] (to-hsl color) slice (normalize slice)] (L/map (function [idx] - (from-hsl [(|> idx nat-to-real (r.* slice) (r.+ hue) normalize) + (from-hsl [(|> idx nat-to-frac (f.* slice) (f.+ hue) normalize) saturation luminance])) (list;n.range +0 (n.dec results)))))) @@ -296,11 +296,11 @@ (if (n.= +0 results) (list) (let [[hue saturation brightness] (to-hsb color) - slice (|> 1.0 (r./ (nat-to-real results)))] + slice (|> 1.0 (f./ (nat-to-frac results)))] (|> (list;n.range +0 (n.dec results)) - (L/map (|>. nat-to-real - (r.* slice) - (r.+ brightness) + (L/map (|>. nat-to-frac + (f.* slice) + (f.+ brightness) normalize [hue saturation] from-hsb)))))) diff --git a/stdlib/source/lux/data/format/css.lux b/stdlib/source/lux/data/format/css.lux index a5adfb928..e4ca7e3cd 100644 --- a/stdlib/source/lux/data/format/css.lux +++ b/stdlib/source/lux/data/format/css.lux @@ -74,7 +74,7 @@ (do-template [<name> <suffix>] [(def: #export (<name> value) - (-> Real Value) + (-> Frac Value) (format (%r value) <suffix>))] [em "em"] diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index 379e3b23b..847b5fa0f 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -11,7 +11,7 @@ (data [bool] [text "text/" Eq<Text> Monoid<Text>] (text ["l" lexer]) - [number "real/" Codec<Text,Real> "nat/" Codec<Text,Nat>] + [number "frac/" Codec<Text,Frac> "nat/" Codec<Text,Nat>] maybe ["R" result] [sum] @@ -32,7 +32,7 @@ [Null Unit] [Boolean Bool] - [Number Real] + [Number Frac] [String Text] ) @@ -72,7 +72,7 @@ [_ (<ast-tag> value)] (wrap (list (` (: JSON (<json-tag> (~ (<ctor> value)))))))) ([#;Bool code;bool #Boolean] - [#;Real code;real #Number] + [#;Frac code;frac #Number] [#;Text code;text #String]) [_ (#;Tag ["" "null"])] @@ -190,7 +190,7 @@ [(<tag> x') (<tag> y')] (:: <struct> = x' y')) ([#Boolean bool;Eq<Bool>] - [#Number number;Eq<Real>] + [#Number number;Eq<Frac>] [#String text;Eq<Text>]) [(#Array xs) (#Array ys)] diff --git a/stdlib/source/lux/data/format/json/codec.lux b/stdlib/source/lux/data/format/json/codec.lux index 8a50757bf..d6d888c0e 100644 --- a/stdlib/source/lux/data/format/json/codec.lux +++ b/stdlib/source/lux/data/format/json/codec.lux @@ -12,7 +12,7 @@ [bit] [text "text/" Eq<Text> Monoid<Text>] (text ["l" lexer]) - [number "real/" Codec<Text,Real> "nat/" Codec<Text,Nat>] + [number "frac/" Codec<Text,Frac> "nat/" Codec<Text,Nat>] maybe ["R" result] [sum] @@ -38,7 +38,7 @@ [(def: <name> (-> <type> Text) <codec>)] [show-boolean ..;Boolean (:: bool;Codec<Text,Bool> encode)] - [show-number ..;Number (:: number;Codec<Text,Real> encode)] + [show-number ..;Number (:: number;Codec<Text,Frac> encode)] [show-string ..;String text;encode]) (def: (show-array show-json elems) @@ -114,7 +114,7 @@ signed?' (l;this? "-") offset (l;many l;decimal)] (wrap ($_ text/append mark (if signed?' "-" "") offset))))] - (case (real/decode ($_ text/append (if signed? "-" "") digits "." decimals exp)) + (case (frac/decode ($_ text/append (if signed? "-" "") digits "." decimals exp)) (#R;Error message) (p;fail message) @@ -185,8 +185,8 @@ L/map) (def: tag - (-> Nat Real) - (|>. nat-to-int int-to-real)) + (-> Nat Frac) + (|>. nat-to-int int-to-frac)) (def: #hidden (rec-encode non-rec) (All [a] (-> (-> (-> a JSON) @@ -202,15 +202,15 @@ (def: (encode input) (let [high (|> input (bit;and high-mask) (bit;unsigned-shift-right +32)) low (bit;and low-mask input)] - (..;array (vector (|> high nat-to-int int-to-real #..;Number) - (|> low nat-to-int int-to-real #..;Number))))) + (..;array (vector (|> high nat-to-int int-to-frac #..;Number) + (|> low nat-to-int int-to-frac #..;Number))))) (def: (decode input) (<| (../reader;run input) (do p;Monad<Parser> [high ../reader;number low ../reader;number]) - (wrap (n.+ (|> high real-to-int int-to-nat (bit;shift-left +32)) - (|> low real-to-int int-to-nat)))))) + (wrap (n.+ (|> high frac-to-int int-to-nat (bit;shift-left +32)) + (|> low frac-to-int int-to-nat)))))) (struct: #hidden _ (Codec JSON Int) (def: encode (|>. int-to-nat (:: Codec<JSON,Nat> encode))) @@ -229,7 +229,7 @@ [Bool poly;bool ..;boolean] [Nat poly;nat (:: ;;Codec<JSON,Nat> (~' encode))] [Int poly;int (:: ;;Codec<JSON,Int> (~' encode))] - [Real poly;real ..;number] + [Frac poly;frac ..;number] [Text poly;text ..;string]) <time> (do-template [<type> <codec>] [(do @ @@ -284,7 +284,7 @@ (case (~ g!input) (~@ (L/join (L/map (function [[tag g!encode]] (list (` ((~ (code;nat tag)) (~ g!input))) - (` (..;json [(~ (code;real (;;tag tag))) + (` (..;json [(~ (code;frac (;;tag tag))) ((~ g!encode) (~ g!input))])))) (list;enumerate members)))))))))) (do @ @@ -336,7 +336,7 @@ [Bool poly;bool ../reader;boolean] [Nat poly;nat (p;codec ;;Codec<JSON,Nat> ../reader;any)] [Int poly;int (p;codec ;;Codec<JSON,Int> ../reader;any)] - [Real poly;real ../reader;number] + [Frac poly;frac ../reader;number] [Text poly;text ../reader;string]) <time> (do-template [<type> <codec>] [(do @ @@ -381,7 +381,7 @@ ($_ p;alt (~@ (L/map (function [[tag memberC]] (` (|> (~ memberC) - (p;after (../reader;number! (~ (code;real (;;tag tag))))) + (p;after (../reader;number! (~ (code;frac (;;tag tag))))) ../reader;array))) (list;enumerate members)))))))) (do @ @@ -418,18 +418,18 @@ (type: Variant (#Case0 Bool) (#Case1 Text) - (#Case2 Real)) + (#Case2 Frac)) (type: Record {#unit Unit #bool Bool - #real Real + #frac Frac #text Text - #maybe (Maybe Real) - #list (List Real) + #maybe (Maybe Frac) + #list (List Frac) #variant Variant - #tuple [Bool Real Text] - #dict (Dict Text Real)}) + #tuple [Bool Frac Text] + #dict (Dict Text Frac)}) (derived: (Codec<JSON,?> Record)))} (with-gensyms [g!inputs] diff --git a/stdlib/source/lux/data/format/json/reader.lux b/stdlib/source/lux/data/format/json/reader.lux index 83713bcf3..1b26d746d 100644 --- a/stdlib/source/lux/data/format/json/reader.lux +++ b/stdlib/source/lux/data/format/json/reader.lux @@ -8,7 +8,7 @@ ["p" parser "p/" Monad<Parser>]) (data [bool] [text "text/" Monoid<Text>] - [number "real/" Codec<Text,Real> "nat/" Codec<Text,Nat>] + [number "frac/" Codec<Text,Frac> "nat/" Codec<Text,Nat>] ["R" result] (coll [list] [vector] @@ -63,7 +63,7 @@ [null Unit #..;Null "null"] [boolean Bool #..;Boolean "boolean"] - [number Real #..;Number "number"] + [number Frac #..;Number "number"] [string Text #..;String "string"] ) @@ -96,7 +96,7 @@ (fail ($_ text/append "JSON value is not a " <desc> ".")))))] [boolean? boolean! Bool bool;Eq<Bool> (:: bool;Codec<Text,Bool> encode) #..;Boolean "boolean" id] - [number? number! Real number;Eq<Real> (:: number;Codec<Text,Real> encode) #..;Number "number" id] + [number? number! Frac number;Eq<Frac> (:: number;Codec<Text,Frac> encode) #..;Number "number" id] [string? string! Text text;Eq<Text> text;encode #..;String "string" id] ) diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index 783e9bc55..713ee943f 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -19,7 +19,7 @@ [ Nat n.=] [ Int i.=] [ Deg d.=] - [Real r.=] + [Frac f.=] ) (do-template [<type> <eq> <lt> <lte> <gt> <gte>] @@ -33,7 +33,7 @@ [ Nat Eq<Nat> n.< n.<= n.> n.>=] [ Int Eq<Int> i.< i.<= i.> i.>=] [Deg Eq<Deg> d.< d.<= d.> d.>=] - [Real Eq<Real> r.< r.<= r.> r.>=] + [Frac Eq<Frac> f.< f.<= f.> f.>=] ) (struct: #export _ (Number Nat) @@ -70,7 +70,7 @@ )] [ Int Order<Int> i.+ i.- i.* i./ i.% i.= i.< 0 1 -1] - [Real Order<Real> r.+ r.- r.* r./ r.% r.= r.< 0.0 1.0 -1.0] + [Frac Order<Frac> f.+ f.- f.* f./ f.% f.= f.< 0.0 1.0 -1.0] ) (struct: #export _ (Number Deg) @@ -93,7 +93,7 @@ [Nat Order<Nat> n.inc n.dec] [Int Order<Int> i.inc i.dec] - [Real Order<Real> (r.+ (_lux_proc [ "real" "smallest-value"] [])) (r.- (_lux_proc [ "real" "smallest-value"] []))] + [Frac Order<Frac> (f.+ (_lux_proc [ "frac" "smallest-value"] [])) (f.- (_lux_proc [ "frac" "smallest-value"] []))] [Deg Order<Deg> (d.+ (_lux_proc [ "deg" "min-value"] [])) (d.- (_lux_proc [ "deg" "min-value"] []))] ) @@ -105,7 +105,7 @@ [ Nat Enum<Nat> (_lux_proc [ "nat" "max-value"] []) (_lux_proc [ "nat" "min-value"] [])] [ Int Enum<Int> (_lux_proc [ "int" "max-value"] []) (_lux_proc [ "int" "min-value"] [])] - [Real Enum<Real> (_lux_proc ["real" "max-value"] []) (_lux_proc ["real" "min-value"] [])] + [Frac Enum<Frac> (_lux_proc ["frac" "max-value"] []) (_lux_proc ["frac" "min-value"] [])] [ Deg Enum<Deg> (_lux_proc [ "deg" "max-value"] []) (_lux_proc [ "deg" "min-value"] [])] ) @@ -122,10 +122,10 @@ [ Mul@Monoid<Int> Int 1 i.*] [ Max@Monoid<Int> Int (:: Interval<Int> bottom) i.max] [ Min@Monoid<Int> Int (:: Interval<Int> top) i.min] - [Add@Monoid<Real> Real 0.0 r.+] - [Mul@Monoid<Real> Real 1.0 r.*] - [Max@Monoid<Real> Real (:: Interval<Real> bottom) r.max] - [Min@Monoid<Real> Real (:: Interval<Real> top) r.min] + [Add@Monoid<Frac> Frac 0.0 f.+] + [Mul@Monoid<Frac> Frac 1.0 f.*] + [Max@Monoid<Frac> Frac (:: Interval<Frac> bottom) f.max] + [Min@Monoid<Frac> Frac (:: Interval<Frac> top) f.min] [ Add@Monoid<Deg> Deg (:: Interval<Deg> bottom) d.+] [ Mul@Monoid<Deg> Deg (:: Interval<Deg> top) d.*] [ Max@Monoid<Deg> Deg (:: Interval<Deg> bottom) d.max] @@ -135,8 +135,8 @@ (do-template [<name> <const> <doc>] [(def: #export <name> {#;doc <doc>} - Real - (_lux_proc ["real" <const>] []))] + Frac + (_lux_proc ["frac" <const>] []))] [not-a-number "not-a-number" "Not-a-number."] [positive-infinity "positive-infinity" "Positive infinity."] @@ -144,15 +144,15 @@ ) (def: #export (not-a-number? number) - {#;doc "Tests whether a real is actually not-a-number."} - (-> Real Bool) - (not (r.= number number))) + {#;doc "Tests whether a frac is actually not-a-number."} + (-> Frac Bool) + (not (f.= number number))) -(def: #export (real? value) - (-> Real Bool) +(def: #export (frac? value) + (-> Frac Bool) (not (or (not-a-number? value) - (r.= positive-infinity value) - (r.= negative-infinity value)))) + (f.= positive-infinity value) + (f.= negative-infinity value)))) (do-template [<type> <encoder> <decoder> <error>] [(struct: #export _ (Codec Text <type>) @@ -167,7 +167,7 @@ #;None (#R;Error <error>))))] - [Real ["real" "encode"] ["real" "decode"] "Could not decode Real"] + [Frac ["frac" "encode"] ["frac" "decode"] "Could not decode Frac"] ) ## [Values & Syntax] @@ -302,21 +302,21 @@ ) (do-template [<struct> <int> <base> <char-set> <error>] - [(struct: #export <struct> (Codec Text Real) + [(struct: #export <struct> (Codec Text Frac) (def: (encode value) - (let [whole (real-to-int value) + (let [whole (frac-to-int value) whole-part (:: <int> encode whole) - decimal (:: Number<Real> abs (r.% 1.0 value)) - decimal-part (if (r.= 0.0 decimal) + decimal (:: Number<Frac> abs (f.% 1.0 value)) + decimal-part (if (f.= 0.0 decimal) ".0" (loop [dec-left decimal output ""] - (if (r.= 0.0 dec-left) + (if (f.= 0.0 dec-left) (_lux_proc ["text" "append"] ["." output]) - (let [shifted (r.* <base> dec-left) - digit (|> shifted (r.% <base>) real-to-int int-to-nat + (let [shifted (f.* <base> dec-left) + digit (|> shifted (f.% <base>) frac-to-int int-to-nat (get-char <char-set>) assume)] - (recur (r.% 1.0 shifted) + (recur (f.% 1.0 shifted) (_lux_proc ["text" "append"] [output digit]))))))] (_lux_proc ["text" "append"] [whole-part decimal-part]))) @@ -337,16 +337,16 @@ (if (n.= +0 muls-left) output (recur (n.dec muls-left) - (r.* <base> output)))) - adjusted-decimal (|> decimal int-to-real (r./ div-power)) + (f.* <base> output)))) + adjusted-decimal (|> decimal int-to-frac (f./ div-power)) dec-deg (case (:: Hex@Codec<Text,Deg> decode (_lux_proc ["text" "append"] ["." decimal-part])) (#R;Success dec-deg) dec-deg (#R;Error error) (error! error))] - (#R;Success (r.+ (int-to-real whole) - (r.* sign adjusted-decimal)))) + (#R;Success (f.+ (int-to-frac whole) + (f.* sign adjusted-decimal)))) _ (#R;Error (_lux_proc ["text" "append"] [<error> repr])))) @@ -354,7 +354,7 @@ _ (#R;Error (_lux_proc ["text" "append"] [<error> repr])))))] - [Binary@Codec<Text,Real> Binary@Codec<Text,Int> 2.0 "01" "Invalid binary syntax: "] + [Binary@Codec<Text,Frac> Binary@Codec<Text,Int> 2.0 "01" "Invalid binary syntax: "] ) (def: (segment-digits chunk-size digits) @@ -493,13 +493,13 @@ ) (do-template [<struct> <error> <from> <to>] - [(struct: #export <struct> (Codec Text Real) + [(struct: #export <struct> (Codec Text Frac) (def: (encode value) - (let [sign (:: Number<Real> signum value) - raw-bin (:: Binary@Codec<Text,Real> encode value) + (let [sign (:: Number<Frac> signum value) + raw-bin (:: Binary@Codec<Text,Frac> encode value) dot-idx (assume (_lux_proc ["text" "index"] [raw-bin "." +0])) whole-part (assume (_lux_proc ["text" "clip"] [raw-bin - (if (r.= -1.0 sign) +1 +0) + (if (f.= -1.0 sign) +1 +0) dot-idx])) decimal-part (assume (_lux_proc ["text" "clip"] [raw-bin (n.inc dot-idx) (_lux_proc ["text" "size"] [raw-bin])])) hex-output (|> (<from> false decimal-part) @@ -507,7 +507,7 @@ (_lux_proc ["text" "append"]) [(<from> true whole-part)] (_lux_proc ["text" "append"]) - [(if (r.= -1.0 sign) "-" "")] + [(if (f.= -1.0 sign) "-" "")] (_lux_proc ["text" "append"]))] hex-output)) @@ -520,16 +520,16 @@ 1.0)] (case (_lux_proc ["text" "index"] [repr "." +0]) (#;Some split-index) - (let [whole-part (assume (_lux_proc ["text" "clip"] [repr (if (r.= -1.0 sign) +1 +0) split-index])) + (let [whole-part (assume (_lux_proc ["text" "clip"] [repr (if (f.= -1.0 sign) +1 +0) split-index])) decimal-part (assume (_lux_proc ["text" "clip"] [repr (n.inc split-index) (_lux_proc ["text" "size"] [repr])])) as-binary (|> (<to> decimal-part) ["."] (_lux_proc ["text" "append"]) [(<to> whole-part)] (_lux_proc ["text" "append"]) - [(if (r.= -1.0 sign) "-" "")] + [(if (f.= -1.0 sign) "-" "")] (_lux_proc ["text" "append"]))] - (case (:: Binary@Codec<Text,Real> decode as-binary) + (case (:: Binary@Codec<Text,Frac> decode as-binary) (#R;Error _) (#R;Error (_lux_proc ["text" "append"] [<error> repr])) @@ -539,11 +539,11 @@ _ (#R;Error (_lux_proc ["text" "append"] [<error> repr]))))))] - [Octal@Codec<Text,Real> "Invalid octaladecimal syntax: " binary-to-octal octal-to-binary] - [Hex@Codec<Text,Real> "Invalid hexadecimal syntax: " binary-to-hex hex-to-binary] + [Octal@Codec<Text,Frac> "Invalid octaladecimal syntax: " binary-to-octal octal-to-binary] + [Hex@Codec<Text,Frac> "Invalid hexadecimal syntax: " binary-to-hex hex-to-binary] ) -(do-template [<macro> <nat> <int> <deg> <real> <error> <doc>] +(do-template [<macro> <nat> <int> <deg> <frac> <error> <doc>] [(macro: #export (<macro> tokens state) {#;doc <doc>} (case tokens @@ -561,8 +561,8 @@ (#R;Success [state (list [meta (#;Deg value)])]) (^multi (#R;Error _) - [(:: <real> decode repr) (#R;Success value)]) - (#R;Success [state (list [meta (#;Real value)])]) + [(:: <frac> decode repr) (#R;Success value)]) + (#R;Success [state (list [meta (#;Frac value)])]) _ (#R;Error <error>)) @@ -570,17 +570,17 @@ _ (#R;Error <error>)))] - [bin Binary@Codec<Text,Nat> Binary@Codec<Text,Int> Binary@Codec<Text,Deg> Binary@Codec<Text,Real> + [bin Binary@Codec<Text,Nat> Binary@Codec<Text,Int> Binary@Codec<Text,Deg> Binary@Codec<Text,Frac> "Invalid binary syntax." - (doc "Given syntax for a binary number, generates a Nat, an Int, a Deg or a Real." + (doc "Given syntax for a binary number, generates a Nat, an Int, a Deg or a Frac." (bin "11001001"))] - [oct Octal@Codec<Text,Nat> Octal@Codec<Text,Int> Octal@Codec<Text,Deg> Octal@Codec<Text,Real> + [oct Octal@Codec<Text,Nat> Octal@Codec<Text,Int> Octal@Codec<Text,Deg> Octal@Codec<Text,Frac> "Invalid octal syntax." - (doc "Given syntax for a octal number, generates a Nat, an Int, a Deg or a Real." + (doc "Given syntax for a octal number, generates a Nat, an Int, a Deg or a Frac." (oct "615243"))] - [hex Hex@Codec<Text,Nat> Hex@Codec<Text,Int> Hex@Codec<Text,Deg> Hex@Codec<Text,Real> + [hex Hex@Codec<Text,Nat> Hex@Codec<Text,Int> Hex@Codec<Text,Deg> Hex@Codec<Text,Frac> "Invalid hexadecimal syntax." - (doc "Given syntax for a hexadecimal number, generates a Nat, an Int, a Deg or a Real." + (doc "Given syntax for a hexadecimal number, generates a Nat, an Int, a Deg or a Frac." (hex "deadBEEF"))] ) @@ -771,8 +771,8 @@ )) (def: (log2 input) - (-> Real Real) - (r./ (_lux_proc ["math" "log"] [2.0]) + (-> Frac Frac) + (f./ (_lux_proc ["math" "log"] [2.0]) (_lux_proc ["math" "log"] [input]))) (def: double-bias Nat +1023) @@ -780,38 +780,38 @@ (def: mantissa-size Nat +52) (def: exponent-size Nat +11) -(def: #export (real-to-bits input) - (-> Real Nat) +(def: #export (frac-to-bits input) + (-> Frac Nat) (cond (not-a-number? input) (hex "+7FF7FFFFFFFFFFFF") - (r.= positive-infinity input) + (f.= positive-infinity input) (hex "+7FF0000000000000") - (r.= negative-infinity input) + (f.= negative-infinity input) (hex "+FFF0000000000000") - (r.= 0.0 input) - (let [reciprocal (r./ input 1.0)] - (if (r.= positive-infinity reciprocal) + (f.= 0.0 input) + (let [reciprocal (f./ input 1.0)] + (if (f.= positive-infinity reciprocal) ## Positive zero (hex "+0000000000000000") ## Negative zero (hex "+8000000000000000"))) ## else - (let [sign (:: Number<Real> signum input) - input (:: Number<Real> abs input) + (let [sign (:: Number<Frac> signum input) + input (:: Number<Frac> abs input) exponent (_lux_proc ["math" "floor"] [(log2 input)]) exponent-mask (|> +1 (bit;shift-left exponent-size) n.dec) mantissa (|> input ## Normalize - (r./ (_lux_proc ["math" "pow"] [2.0 exponent])) + (f./ (_lux_proc ["math" "pow"] [2.0 exponent])) ## Make it int-equivalent - (r.* (_lux_proc ["math" "pow"] [2.0 52.0]))) - sign-bit (if (r.= -1.0 sign) +1 +0) - exponent-bits (|> exponent real-to-int int-to-nat (n.+ double-bias) (bit;and exponent-mask)) - mantissa-bits (|> mantissa real-to-int int-to-nat)] + (f.* (_lux_proc ["math" "pow"] [2.0 52.0]))) + sign-bit (if (f.= -1.0 sign) +1 +0) + exponent-bits (|> exponent frac-to-int int-to-nat (n.+ double-bias) (bit;and exponent-mask)) + mantissa-bits (|> mantissa frac-to-int int-to-nat)] ($_ bit;or (bit;shift-left +63 sign-bit) (bit;shift-left mantissa-size exponent-bits) @@ -829,8 +829,8 @@ [sign sign-mask +1 (n.+ exponent-size mantissa-size)] ) -(def: #export (bits-to-real input) - (-> Nat Real) +(def: #export (bits-to-frac input) + (-> Nat Frac) (let [S (sign input) E (exponent input) M (mantissa input)] @@ -844,20 +844,20 @@ (and (n.= +0 E) (n.= +0 M)) (if (n.= +0 S) 0.0 - (r.* -1.0 0.0)) + (f.* -1.0 0.0)) ## else (let [normalized (|> M (bit;set mantissa-size) - nat-to-int int-to-real - (r./ (_lux_proc ["math" "pow"] [2.0 52.0]))) + nat-to-int int-to-frac + (f./ (_lux_proc ["math" "pow"] [2.0 52.0]))) power (|> E (n.- double-bias) - nat-to-int int-to-real + nat-to-int int-to-frac [2.0] (_lux_proc ["math" "pow"])) - shifted (r.* power + shifted (f.* power normalized)] (if (n.= +0 S) shifted - (r.* -1.0 shifted)))))) + (f.* -1.0 shifted)))))) ## [Hash] (struct: #export _ (Hash Nat) @@ -868,10 +868,10 @@ (def: eq Eq<Int>) (def: hash int-to-nat)) -(struct: #export _ (Hash Real) - (def: eq Eq<Real>) +(struct: #export _ (Hash Frac) + (def: eq Eq<Frac>) - (def: hash real-to-bits)) + (def: hash frac-to-bits)) (struct: #export _ (Hash Deg) (def: eq Eq<Deg>) diff --git a/stdlib/source/lux/data/number/complex.lux b/stdlib/source/lux/data/number/complex.lux index a3a2fe217..3b8fb7f00 100644 --- a/stdlib/source/lux/data/number/complex.lux +++ b/stdlib/source/lux/data/number/complex.lux @@ -6,7 +6,7 @@ codec ["M" monad #+ do Monad] ["p" parser]) - (data [number "r/" Number<Real> Codec<Text,Real>] + (data [number "f/" Number<Frac> Codec<Text,Frac>] [text "text/" Monoid<Text>] text/format ["R" result] @@ -20,8 +20,8 @@ ## https://github.com/apache/commons-math/blob/master/src/main/java/org/apache/commons/math4/complex/Complex.java (type: #export Complex - {#real Real - #imaginary Real}) + {#real Frac + #imaginary Frac}) (syntax: #export (complex real [?imaginary (p;opt s;any)]) {#;doc (doc "Complex literals." @@ -44,9 +44,9 @@ (def: #export (c.= param input) (-> Complex Complex Bool) - (and (r.= (get@ #real param) + (and (f.= (get@ #real param) (get@ #real input)) - (r.= (get@ #imaginary param) + (f.= (get@ #imaginary param) (get@ #imaginary input)))) (do-template [<name> <op>] @@ -57,8 +57,8 @@ #imaginary (<op> (get@ #imaginary param) (get@ #imaginary input))})] - [c.+ r.+] - [c.- r.-] + [c.+ f.+] + [c.- f.-] ) (struct: #export _ (Eq Complex) @@ -66,55 +66,55 @@ (def: #export c.negate (-> Complex Complex) - (|>. (update@ #real r/negate) - (update@ #imaginary r/negate))) + (|>. (update@ #real f/negate) + (update@ #imaginary f/negate))) (def: #export c.signum (-> Complex Complex) - (|>. (update@ #real r/signum) - (update@ #imaginary r/signum))) + (|>. (update@ #real f/signum) + (update@ #imaginary f/signum))) (def: #export conjugate (-> Complex Complex) - (update@ #imaginary r/negate)) + (update@ #imaginary f/negate)) (def: #export (c.*' param input) - (-> Real Complex Complex) - {#real (r.* param + (-> Frac Complex Complex) + {#real (f.* param (get@ #real input)) - #imaginary (r.* param + #imaginary (f.* param (get@ #imaginary input))}) (def: #export (c.* param input) (-> Complex Complex Complex) - {#real (r.- (r.* (get@ #imaginary param) + {#real (f.- (f.* (get@ #imaginary param) (get@ #imaginary input)) - (r.* (get@ #real param) + (f.* (get@ #real param) (get@ #real input))) - #imaginary (r.+ (r.* (get@ #real param) + #imaginary (f.+ (f.* (get@ #real param) (get@ #imaginary input)) - (r.* (get@ #imaginary param) + (f.* (get@ #imaginary param) (get@ #real input)))}) (def: #export (c./ param input) (-> Complex Complex Complex) (let [(^slots [#real #imaginary]) param] - (if (r.< (r/abs imaginary) - (r/abs real)) - (let [quot (r./ imaginary real) - denom (|> real (r.* quot) (r.+ imaginary))] - {#real (|> (get@ #real input) (r.* quot) (r.+ (get@ #imaginary input)) (r./ denom)) - #imaginary (|> (get@ #imaginary input) (r.* quot) (r.- (get@ #real input)) (r./ denom))}) - (let [quot (r./ real imaginary) - denom (|> imaginary (r.* quot) (r.+ real))] - {#real (|> (get@ #imaginary input) (r.* quot) (r.+ (get@ #real input)) (r./ denom)) - #imaginary (|> (get@ #imaginary input) (r.- (r.* quot (get@ #real input))) (r./ 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 (c./' param subject) - (-> Real Complex Complex) + (-> Frac Complex Complex) (let [(^slots [#real #imaginary]) subject] - {#real (r./ param real) - #imaginary (r./ param imaginary)})) + {#real (f./ param real) + #imaginary (f./ param imaginary)})) (def: #export (c.% param input) (-> Complex Complex Complex) @@ -128,68 +128,68 @@ (def: #export (cos subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject] - {#real (r.* (math;cosh imaginary) + {#real (f.* (math;cosh imaginary) (math;cos real)) - #imaginary (r.* (math;sinh imaginary) - (r/negate (math;sin real)))})) + #imaginary (f.* (math;sinh imaginary) + (f/negate (math;sin real)))})) (def: #export (cosh subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject] - {#real (r.* (math;cos imaginary) + {#real (f.* (math;cos imaginary) (math;cosh real)) - #imaginary (r.* (math;sin imaginary) + #imaginary (f.* (math;sin imaginary) (math;sinh real))})) (def: #export (sin subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject] - {#real (r.* (math;cosh imaginary) + {#real (f.* (math;cosh imaginary) (math;sin real)) - #imaginary (r.* (math;sinh imaginary) + #imaginary (f.* (math;sinh imaginary) (math;cos real))})) (def: #export (sinh subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject] - {#real (r.* (math;cos imaginary) + {#real (f.* (math;cos imaginary) (math;sinh real)) - #imaginary (r.* (math;sin imaginary) + #imaginary (f.* (math;sin imaginary) (math;cosh real))})) (def: #export (tan subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject - r2 (r.* 2.0 real) - i2 (r.* 2.0 imaginary) - d (r.+ (math;cos r2) (math;cosh i2))] - {#real (r./ d (math;sin r2)) - #imaginary (r./ 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 (r.* 2.0 real) - i2 (r.* 2.0 imaginary) - d (r.+ (math;cosh r2) (math;cos i2))] - {#real (r./ d (math;sinh r2)) - #imaginary (r./ 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 (c.abs subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject] - (complex (if (r.< (r/abs imaginary) - (r/abs real)) - (if (r.= 0.0 imaginary) - (r/abs real) - (let [q (r./ imaginary real)] - (r.* (math;root2 (r.+ 1.0 (r.* q q))) - (r/abs imaginary)))) - (if (r.= 0.0 real) - (r/abs imaginary) - (let [q (r./ real imaginary)] - (r.* (math;root2 (r.+ 1.0 (r.* q q))) - (r/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;root2 (f.+ 1.0 (f.* q q))) + (f/abs imaginary)))) + (if (f.= 0.0 real) + (f/abs imaginary) + (let [q (f./ real imaginary)] + (f.* (math;root2 (f.+ 1.0 (f.* q q))) + (f/abs real)))) )))) (struct: #export _ (Number Complex) @@ -200,20 +200,20 @@ (def: % c.%) (def: (negate x) (|> x - (update@ #real r/negate) - (update@ #imaginary r/negate))) + (update@ #real f/negate) + (update@ #imaginary f/negate))) (def: abs c.abs) (def: (signum x) (|> x - (update@ #real r/signum) - (update@ #imaginary r/signum)))) + (update@ #real f/signum) + (update@ #imaginary f/signum)))) (def: #export (exp subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject r-exp (math;exp real)] - {#real (r.* r-exp (math;cos imaginary)) - #imaginary (r.* 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) @@ -227,23 +227,23 @@ (|> input log (<op> param) exp))] [pow Complex c.*] - [pow' Real c.*'] + [pow' Frac c.*'] ) (def: (copy-sign sign magnitude) - (-> Real Real Real) - (r.* (r/signum sign) magnitude)) + (-> Frac Frac Frac) + (f.* (f/signum sign) magnitude)) (def: #export (root2 (^@ input (^slots [#real #imaginary]))) (-> Complex Complex) - (let [t (|> input c.abs (get@ #real) (r.+ (r/abs real)) (r./ 2.0) math;root2)] - (if (r.>= 0.0 real) + (let [t (|> input c.abs (get@ #real) (f.+ (f/abs real)) (f./ 2.0) math;root2)] + (if (f.>= 0.0 real) {#real t - #imaginary (r./ (r.* 2.0 t) + #imaginary (f./ (f.* 2.0 t) imaginary)} - {#real (r./ (r.* 2.0 t) - (r/abs imaginary)) - #imaginary (r.* 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) @@ -251,18 +251,18 @@ (def: #export (reciprocal (^slots [#real #imaginary])) (-> Complex Complex) - (if (r.< (r/abs imaginary) - (r/abs real)) - (let [q (r./ imaginary real) - scale (r./ (|> real (r.* q) (r.+ imaginary)) + (if (f.< (f/abs imaginary) + (f/abs real)) + (let [q (f./ imaginary real) + scale (f./ (|> real (f.* q) (f.+ imaginary)) 1.0)] - {#real (r.* q scale) - #imaginary (r/negate scale)}) - (let [q (r./ real imaginary) - scale (r./ (|> imaginary (r.* q) (r.+ 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 r/negate (r.* q))}))) + #imaginary (|> scale f/negate (f.* q))}))) (def: #export (acos input) (-> Complex Complex) @@ -288,32 +288,32 @@ (c.* (c./ (complex 2.0) i)))) (def: #export (argument (^slots [#real #imaginary])) - (-> Complex Real) + (-> Complex Frac) (math;atan2 real imaginary)) (def: #export (nth-roots nth input) (-> Nat Complex (List Complex)) (if (n.= +0 nth) (list) - (let [r-nth (|> nth nat-to-int int-to-real) - nth-root-of-abs (|> input c.abs (get@ #real) (math;pow (r./ r-nth 1.0))) - nth-phi (|> input argument (r./ r-nth)) - slice (|> math;pi (r.* 2.0) (r./ r-nth))] + (let [r-nth (|> nth nat-to-int int-to-frac) + nth-root-of-abs (|> input c.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;n.range +0 (n.dec nth)) (L/map (function [nth'] - (let [inner (|> nth' nat-to-int int-to-real - (r.* slice) - (r.+ nth-phi)) - real (r.* nth-root-of-abs + (let [inner (|> nth' nat-to-int int-to-frac + (f.* slice) + (f.+ nth-phi)) + real (f.* nth-root-of-abs (math;cos inner)) - imaginary (r.* nth-root-of-abs + imaginary (f.* nth-root-of-abs (math;sin inner))] {#real real #imaginary imaginary}))))))) (struct: #export _ (Codec Text Complex) (def: (encode (^slots [#real #imaginary])) - ($_ text/append "(" (r/encode real) ", " (r/encode imaginary) ")")) + ($_ text/append "(" (f/encode real) ", " (f/encode imaginary) ")")) (def: (decode input) (case (do maybe;Monad<Maybe> @@ -324,8 +324,8 @@ (#;Some [r' i']) (do R;Monad<Result> - [r (r/decode (text;trim r')) - i (r/decode (text;trim i'))] + [r (f/decode (text;trim r')) + i (f/decode (text;trim i'))] (wrap {#real r #imaginary i})) ))) diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux index 37e5e7cb6..db33bdc05 100644 --- a/stdlib/source/lux/data/text/format.lux +++ b/stdlib/source/lux/data/text/format.lux @@ -42,7 +42,7 @@ [%n Nat (:: number;Codec<Text,Nat> encode)] [%i Int (:: number;Codec<Text,Int> encode)] [%d Deg (:: number;Codec<Text,Deg> encode)] - [%r Real (:: number;Codec<Text,Real> encode)] + [%r Frac (:: number;Codec<Text,Frac> encode)] [%t Text text;encode] [%ident Ident (:: ident;Codec<Text,Ident> encode)] [%code Code code;to-text] diff --git a/stdlib/source/lux/host.js.lux b/stdlib/source/lux/host.js.lux index 2a6aa45f4..258de1b8d 100644 --- a/stdlib/source/lux/host.js.lux +++ b/stdlib/source/lux/host.js.lux @@ -21,7 +21,7 @@ [(type: #export <name> <type>)] [String Text] - [Number Real] + [Number Frac] [Boolean Bool] ) @@ -39,7 +39,7 @@ (syntax: #export (get field-name type object) {#;doc (doc "A way to get fields from objects." (get "ceil" (ref "Math")) - (get "ceil" (-> Real Real) (ref "Math")))} + (get "ceil" (-> Frac Frac) (ref "Math")))} (wrap (list (` (:! (~ type) (;_lux_proc ["js" "get-field"] [(~ object) (~ field-name)])))))) @@ -55,7 +55,7 @@ (syntax: #export (ref [name s;text] [type (p;opt s;any)]) {#;doc (doc "A way to refer to JavaScript variables." (ref "document") - (ref "Math.ceil" (-> Real Real)))} + (ref "Math.ceil" (-> Frac Frac)))} (wrap (list (` (:! (~ (default (' ;;Object) type)) (;_lux_proc ["js" "ref"] [(~ (code;text name))])))))) diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index a735a8570..42a076b8f 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -276,8 +276,8 @@ ["short" ;Int] ["int" ;Int] ["long" ;Int] - ["float" ;Real] - ["double" ;Real] + ["float" ;Frac] + ["double" ;Frac] ["void" ;Unit]) _ diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux index 88e2b4d91..a7a5d22cd 100644 --- a/stdlib/source/lux/macro.lux +++ b/stdlib/source/lux/macro.lux @@ -167,7 +167,7 @@ [get-bool-ann #;BoolA Bool] [get-int-ann #;IntA Int] - [get-real-ann #;RealA Real] + [get-frac-ann #;FracA Frac] [get-text-ann #;TextA Text] [get-ident-ann #;IdentA Ident] [get-list-ann #;ListA (List Ann-Value)] diff --git a/stdlib/source/lux/macro/code.lux b/stdlib/source/lux/macro/code.lux index 2755ae6f5..a171d74d5 100644 --- a/stdlib/source/lux/macro/code.lux +++ b/stdlib/source/lux/macro/code.lux @@ -13,7 +13,7 @@ ## (#;Bool Bool) ## (#;Nat Nat) ## (#;Int Int) -## (#;Real Real) +## (#;Frac Frac) ## (#;Text Text) ## (#;Symbol Text Text) ## (#;Tag Text Text) @@ -37,7 +37,7 @@ [nat Nat #;Nat] [int Int #;Int] [deg Deg #;Deg] - [real Real #;Real] + [frac Frac #;Frac] [text Text #;Text] [symbol Ident #;Symbol] [tag Ident #;Tag] @@ -66,7 +66,7 @@ [#;Nat Eq<Nat>] [#;Int Eq<Int>] [#;Deg Eq<Deg>] - [#;Real Eq<Real>] + [#;Frac Eq<Frac>] [#;Text Eq<Text>] [#;Symbol Eq<Ident>] [#;Tag Eq<Ident>]) @@ -102,7 +102,7 @@ [#;Nat Codec<Text,Nat>] [#;Int Codec<Text,Int>] [#;Deg Codec<Text,Deg>] - [#;Real Codec<Text,Real>] + [#;Frac Codec<Text,Frac>] [#;Symbol Codec<Text,Ident>]) [_ (#;Text value)] diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index 995cc023a..bc8d5d375 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -131,7 +131,7 @@ [nat "Nat" (#;Host "#Nat" #;Nil)] [int "Int" (#;Host "#Int" #;Nil)] [deg "Deg" (#;Host "#Deg" #;Nil)] - [real "Real" (#;Host "#Real" #;Nil)] + [frac "Frac" (#;Host "#Frac" #;Nil)] [text "Text" (#;Host "#Text" #;Nil)] ) @@ -146,7 +146,7 @@ nat int deg - real + frac text)) (#R;Error error) (p;fail error) diff --git a/stdlib/source/lux/macro/poly/eq.lux b/stdlib/source/lux/macro/poly/eq.lux index b4d1a5231..45013ebb8 100644 --- a/stdlib/source/lux/macro/poly/eq.lux +++ b/stdlib/source/lux/macro/poly/eq.lux @@ -43,7 +43,7 @@ [poly;nat number;Eq<Nat>] [poly;int number;Eq<Int>] [poly;deg number;Eq<Deg>] - [poly;real number;Eq<Real>] + [poly;frac number;Eq<Frac>] [poly;text text;Eq<Text>]) <time> (do-template [<type> <eq>] [(do @ diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index f56c84e1b..4a05041f6 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -58,7 +58,7 @@ [ nat Nat #;Nat number;Eq<Nat> "nat"] [ int Int #;Int number;Eq<Int> "int"] [ deg Deg #;Deg number;Eq<Deg> "deg"] - [ real Real #;Real number;Eq<Real> "real"] + [ frac Frac #;Frac number;Eq<Frac> "frac"] [ text Text #;Text text;Eq<Text> "text"] [symbol Ident #;Symbol ident;Eq<Ident> "symbol"] [ tag Ident #;Tag ident;Eq<Ident> "tag"] diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux index e5e06bd16..73c37d598 100644 --- a/stdlib/source/lux/math.lux +++ b/stdlib/source/lux/math.lux @@ -11,7 +11,7 @@ ## [Values] (do-template [<name> <value>] [(def: #export <name> - Real + Frac (_lux_proc ["math" <value>] []))] [e "e"] @@ -20,12 +20,12 @@ (def: #export tau {#;doc "The same as 2*PI."} - Real + Frac 6.28318530717958647692) (do-template [<name> <method>] [(def: #export (<name> input) - (-> Real Real) + (-> Frac Frac) (_lux_proc ["math" <method>] [input]))] [cos "cos"] @@ -53,7 +53,7 @@ (do-template [<name> <method>] [(def: #export (<name> param subject) - (-> Real Real Real) + (-> Frac Frac Frac) (_lux_proc ["math" <method>] [subject param]))] [atan2 "atan2"] @@ -61,7 +61,7 @@ ) (def: #export (log' base input) - (r./ (log base) + (f./ (log base) (log input))) (def: #export (factorial n) @@ -73,8 +73,8 @@ (recur (n.* n acc) (n.dec n))))) (def: #export (hypotenuse catA catB) - (-> Real Real Real) - (root2 (r.+ (pow 2.0 catA) + (-> Frac Frac Frac) + (root2 (f.+ (pow 2.0 catA) (pow 2.0 catB)))) (def: #export (gcd a b) @@ -109,7 +109,7 @@ (p/map code;nat s;nat) (p/map code;int s;int) (p/map code;deg s;deg) - (p/map code;real s;real) + (p/map code;frac s;frac) (p/map code;text s;text) (p/map code;symbol s;symbol) (p/map code;tag s;tag)) diff --git a/stdlib/source/lux/math/logic/fuzzy.lux b/stdlib/source/lux/math/logic/fuzzy.lux index c3677649b..84e217d6b 100644 --- a/stdlib/source/lux/math/logic/fuzzy.lux +++ b/stdlib/source/lux/math/logic/fuzzy.lux @@ -82,7 +82,7 @@ (<descending> from to)))] [d.ascending d.descending d.gradient Deg d.< d.> d.<= d.>= d.- d./ id] - [r.ascending r.descending r.gradient Real r.< r.> r.<= r.>= r.- r./ real-to-deg] + [f.ascending f.descending f.gradient Frac f.< f.> f.<= f.>= f.- f./ frac-to-deg] ) (do-template [<triangle> <trapezoid> <type> <ascending> <descending> <lt>] @@ -107,22 +107,22 @@ (undefined)))] [d.triangle d.trapezoid Deg d.ascending d.descending d.<] - [r.triangle r.trapezoid Real r.ascending r.descending r.<] + [f.triangle f.trapezoid Frac f.ascending f.descending f.<] ) (def: #export (gaussian deviation center) - (-> Real Real (Fuzzy Real)) + (-> Frac Frac (Fuzzy Frac)) (function [elem] - (let [scale (|> deviation (math;pow 2.0) (r.* 2.0)) + (let [scale (|> deviation (math;pow 2.0) (f.* 2.0)) membership (|> elem - (r.- center) + (f.- center) (math;pow 2.0) - (r.* -1.0) - (r./ scale) + (f.* -1.0) + (f./ scale) math;exp)] - (if (r.= 1.0 membership) + (if (f.= 1.0 membership) &;~true - (real-to-deg membership))))) + (frac-to-deg membership))))) (def: #export (cut treshold set) (All [a] (-> Deg (Fuzzy a) (Fuzzy a))) diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux index 376dd9192..7a0c2963d 100644 --- a/stdlib/source/lux/math/random.lux +++ b/stdlib/source/lux/math/random.lux @@ -84,20 +84,20 @@ (let [[prng output] (prng [])] [prng (bit;unsigned-shift-right (n.- n +64) output)]))) -(def: #export real - (Random Real) +(def: #export frac + (Random Frac) (do Monad<Random> [left (bits +26) right (bits +27)] (wrap (|> right (n.+ (bit;shift-left +27 left)) nat-to-int - int-to-real - (r./ (|> +1 (bit;shift-left +53) nat-to-int int-to-real)))))) + int-to-frac + (f./ (|> +1 (bit;shift-left +53) nat-to-int int-to-frac)))))) (def: #export deg (Random Deg) - (:: Monad<Random> map real-to-deg real)) + (:: Monad<Random> map frac-to-deg frac)) (def: #export (text' char-gen size) (-> (Random Nat) Nat (Random Text)) @@ -121,7 +121,7 @@ (wrap (<ctor> left right))))] [ratio r;Ratio r;ratio nat] - [complex c;Complex c;complex real] + [complex c;Complex c;complex frac] ) (def: #export (seq left right) diff --git a/stdlib/test/test/lux.lux b/stdlib/test/test/lux.lux index dcf1997f0..41b3bc555 100644 --- a/stdlib/test/test/lux.lux +++ b/stdlib/test/test/lux.lux @@ -69,7 +69,7 @@ ["Int" R;int i.= i.< i.> i.<= i.>= i.min i.max] ["Nat" R;nat n.= n.< n.> n.<= n.>= n.min n.max] - ["Real" R;real r.= r.< r.> r.<= r.>= r.min r.max] + ["Frac" R;frac f.= f.< f.> f.<= f.>= f.min f.max] ["Deg" R;deg d.= d.< d.> d.<= d.>= d.min d.max] ) @@ -117,7 +117,7 @@ ["Nat" R;nat n.= n.+ n.- n.* n./ n.% n.> +0 +1 +1000000 %n (n.% +1000) id] ["Int" R;int i.= i.+ i.- i.* i./ i.% i.> 0 1 1000000 %i (i.% 1000) id] - ["Real" R;real r.= r.+ r.- r.* r./ r.% r.> 0.0 1.0 1000000.0 %r id math;floor] + ["Frac" R;frac f.= f.+ f.- f.* f./ f.% f.> 0.0 1.0 1000000.0 %r id math;floor] ["Deg" R;deg d.= d.+ d.- d.* d./ d.% d.> .0 (_lux_proc ["deg" "max-value"] []) (_lux_proc ["deg" "max-value"] []) %f id id] ) @@ -130,9 +130,9 @@ ["Int->Nat" R;int int-to-nat nat-to-int i.= (i.% 1000000) %i %n] ["Nat->Int" R;nat nat-to-int int-to-nat n.= (n.% +1000000) %n %i] - ["Int->Real" R;int int-to-real real-to-int i.= (i.% 1000000) %i %r] - ["Real->Int" R;real real-to-int int-to-real r.= math;floor %r %i] - ## [R;real real-to-deg deg-to-real r.= (r.% 1.0) %r %f] + ["Int->Frac" R;int int-to-frac frac-to-int i.= (i.% 1000000) %i %r] + ["Frac->Int" R;frac frac-to-int int-to-frac f.= math;floor %r %i] + ## [R;frac frac-to-deg deg-to-frac f.= (f.% 1.0) %r %f] ) (context: "Simple macros and constructs" diff --git a/stdlib/test/test/lux/data/color.lux b/stdlib/test/test/lux/data/color.lux index 0187f9430..5ca3c95c3 100644 --- a/stdlib/test/test/lux/data/color.lux +++ b/stdlib/test/test/lux/data/color.lux @@ -3,7 +3,7 @@ (lux [io] (control [monad #+ do]) (data ["@" color] - [number "real/" Number<Real>]) + [number "frac/" Number<Frac>]) [math] ["r" math/random]) lux/test) @@ -14,28 +14,28 @@ (:: r;Monad<Random> map @;color))) (def: scale - (-> Nat Real) - (|>. nat-to-int int-to-real)) + (-> Nat Frac) + (|>. nat-to-int int-to-frac)) -(def: square (-> Real Real) (math;pow 2.0)) +(def: square (-> Frac Frac) (math;pow 2.0)) (def: (distance from to) - (-> @;Color @;Color Real) + (-> @;Color @;Color Frac) (let [[fr fg fb] (@;unpack from) [tr tg tb] (@;unpack to)] - (math;root2 ($_ r.+ - (|> (scale tr) (r.- (scale fr)) square) - (|> (scale tg) (r.- (scale fg)) square) - (|> (scale tb) (r.- (scale fb)) square))))) + (math;root2 ($_ f.+ + (|> (scale tr) (f.- (scale fr)) square) + (|> (scale tg) (f.- (scale fg)) square) + (|> (scale tb) (f.- (scale fb)) square))))) -(def: error-margin Real 1.8) +(def: error-margin Frac 1.8) (def: black @;Color (@;color [+0 +0 +0])) (def: white @;Color (@;color [+255 +255 +255])) (do-template [<field>] [(def: (<field> color) - (-> @;Color Real) + (-> @;Color Frac) (let [[hue saturation luminance] (@;to-hsl color)] <field>))] @@ -46,33 +46,33 @@ (context: "Color." [any color colorful (|> color - (r;filter (function [color] (|> (distance color black) (r.>= 100.0)))) - (r;filter (function [color] (|> (distance color white) (r.>= 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 (r.>= 0.25 saturation) - (r.<= 0.75 saturation))))))) - ratio (|> r;real (r;filter (r.>= 0.5)))] + (and (f.>= 0.25 saturation) + (f.<= 0.75 saturation))))))) + ratio (|> r;frac (r;filter (f.>= 0.5)))] ($_ seq (test "Has equality." (:: @;Eq<Color> = any any)) (test "Can convert to/from HSL." (|> any @;to-hsl @;from-hsl (distance any) - (r.<= error-margin))) + (f.<= error-margin))) (test "Can convert to/from HSB." (|> any @;to-hsb @;from-hsb (distance any) - (r.<= error-margin))) + (f.<= error-margin))) (test "Can convert to/from CMYK." (|> any @;to-cmyk @;from-cmyk (distance any) - (r.<= error-margin))) + (f.<= error-margin))) (test "Can interpolate between 2 colors." - (and (r.<= (distance colorful black) + (and (f.<= (distance colorful black) (distance (@;darker ratio colorful) black)) - (r.<= (distance colorful white) + (f.<= (distance colorful white) (distance (@;brighter ratio colorful) white)))) (test "Can calculate complement." (let [~any (@;complement any) @@ -80,17 +80,17 @@ (and (not (@/= any ~any)) (@/= any (@;complement ~any))))) (test "Can saturate color." - (r.> (saturation mediocre) + (f.> (saturation mediocre) (saturation (@;saturate ratio mediocre)))) (test "Can de-saturate color." - (r.< (saturation mediocre) + (f.< (saturation mediocre) (saturation (@;de-saturate ratio mediocre)))) (test "Can gray-scale color." (let [gray'ed (@;gray-scale mediocre)] - (and (r.= 0.0 + (and (f.= 0.0 (saturation gray'ed)) (|> (luminance gray'ed) - (r.- (luminance mediocre)) - real/abs - (r.<= error-margin))))) + (f.- (luminance mediocre)) + frac/abs + (f.<= error-margin))))) )) diff --git a/stdlib/test/test/lux/data/format/json.lux b/stdlib/test/test/lux/data/format/json.lux index 68e1427ee..2dce7ad84 100644 --- a/stdlib/test/test/lux/data/format/json.lux +++ b/stdlib/test/test/lux/data/format/json.lux @@ -35,7 +35,7 @@ ($_ r;alt (:: @ wrap []) r;bool - (|> r;real (:: @ map (r.* 1_000_000.0))) + (|> r;frac (:: @ map (f.* 1_000_000.0))) (r;text size) (r;vector size gen-json) (r;dict text;Hash<Text> size (r;text size) gen-json) @@ -61,29 +61,29 @@ (type: Variant (#Case0 Bool) (#Case1 Text) - (#Case2 Real)) + (#Case2 Frac)) (type: #rec Recursive - (#Number Real) - (#Addition Real Recursive)) + (#Number Frac) + (#Addition Frac Recursive)) (type: Record {#unit Unit #bool Bool - #real Real + #frac Frac #text Text - #maybe (Maybe Real) - #list (List Real) + #maybe (Maybe Frac) + #list (List Frac) #variant Variant - #tuple [Bool Real Text] - #dict (d;Dict Text Real) + #tuple [Bool Frac Text] + #dict (d;Dict Text Frac) #recursive Recursive}) (def: gen-recursive (r;Random Recursive) (r;rec (function [gen-recursive] - (r;alt r;real - (r;seq r;real gen-recursive))))) + (r;alt r;frac + (r;seq r;frac gen-recursive))))) (derived: (poly/eq;Eq<?> Recursive)) @@ -94,13 +94,13 @@ ($_ r;seq (:: @ wrap []) r;bool - r;real + r;frac (r;text size) - (r;maybe r;real) - (r;list size r;real) - ($_ r;alt r;bool (r;text size) r;real) - ($_ r;seq r;bool r;real (r;text size)) - (r;dict text;Hash<Text> size (r;text size) r;real) + (r;maybe r;frac) + (r;list size r;frac) + ($_ r;alt r;bool (r;text size) r;frac) + ($_ r;seq r;bool r;frac (r;text size)) + (r;dict text;Hash<Text> size (r;text size) r;frac) gen-recursive ))) @@ -117,22 +117,22 @@ (:: text;Eq<Text> = left' right') [(#Case2 left') (#Case2 right')] - (r.= left' right') + (f.= left' right') _ false))] (and (:: bool;Eq<Bool> = (get@ #bool recL) (get@ #bool recR)) - (r.= (get@ #real recL) (get@ #real recR)) + (f.= (get@ #frac recL) (get@ #frac recR)) (:: text;Eq<Text> = (get@ #text recL) (get@ #text recR)) - (:: (maybe;Eq<Maybe> number;Eq<Real>) = (get@ #maybe recL) (get@ #maybe recR)) - (:: (list;Eq<List> number;Eq<Real>) = (get@ #list recL) (get@ #list recR)) + (:: (maybe;Eq<Maybe> number;Eq<Frac>) = (get@ #maybe recL) (get@ #maybe recR)) + (:: (list;Eq<List> number;Eq<Frac>) = (get@ #list recL) (get@ #list recR)) (variant/= (get@ #variant recL) (get@ #variant recR)) (let [[tL0 tL1 tL2] (get@ #tuple recL) [tR0 tR1 tR2] (get@ #tuple recR)] (and (:: bool;Eq<Bool> = tL0 tR0) - (r.= tL1 tR1) + (f.= tL1 tR1) (:: text;Eq<Text> = tL2 tR2))) - (:: (d;Eq<Dict> number;Eq<Real>) = (get@ #dict recL) (get@ #dict recR)) + (:: (d;Eq<Dict> number;Eq<Frac>) = (get@ #dict recL) (get@ #dict recR)) (:: Eq<Recursive> = (get@ #recursive recL) (get@ #recursive recR)) )))) diff --git a/stdlib/test/test/lux/data/number.lux b/stdlib/test/test/lux/data/number.lux index dc6a1ad29..b715119c6 100644 --- a/stdlib/test/test/lux/data/number.lux +++ b/stdlib/test/test/lux/data/number.lux @@ -20,7 +20,7 @@ ["Nat" R;nat Eq<Nat> Order<Nat>] ["Int" R;int Eq<Int> Order<Int>] - ["Real" R;real Eq<Real> Order<Real>] + ["Frac" R;frac Eq<Frac> Order<Frac>] ["Deg" R;deg Eq<Deg> Order<Deg>] ) @@ -31,7 +31,7 @@ (^open) <Order>]] (test "" (and (>= x (abs x)) ## abs(0.0) == 0.0 && negate(abs(0.0)) == -0.0 - (or (Text/= "Real" category) + (or (Text/= "Frac" category) (not (= x (negate x)))) (= x (negate (negate x))) ## There is loss of precision when multiplying @@ -41,7 +41,7 @@ ## ["Nat" R;nat Number<Nat>] ["Int" R;int Number<Int> Order<Int>] - ["Real" R;real Number<Real> Order<Real>] + ["Frac" R;frac Number<Frac> Order<Frac>] ["Deg" R;deg Number<Deg> Order<Deg>] ) @@ -76,7 +76,7 @@ ["Nat" R;nat Number<Nat> Order<Nat> Interval<Nat> (function [_] true)] ["Int" R;int Number<Int> Order<Int> Interval<Int> (function [_] true)] ## Both min and max values will be positive (thus, greater than zero) - ["Real" R;real Number<Real> Order<Real> Interval<Real> (r.> 0.0)] + ["Frac" R;frac Number<Frac> Order<Frac> Interval<Frac> (f.> 0.0)] ["Deg" R;deg Number<Deg> Order<Deg> Interval<Deg> (function [_] true)] ) @@ -99,10 +99,10 @@ ["Int/Mul" R;int Number<Int> Order<Int> Mul@Monoid<Int> (i.% 1000) (function [_] true)] ["Int/Min" R;int Number<Int> Order<Int> Min@Monoid<Int> (i.% 1000) (function [_] true)] ["Int/Max" R;int Number<Int> Order<Int> Max@Monoid<Int> (i.% 1000) (function [_] true)] - ["Real/Add" R;real Number<Real> Order<Real> Add@Monoid<Real> (r.% 1000.0) (r.> 0.0)] - ["Real/Mul" R;real Number<Real> Order<Real> Mul@Monoid<Real> (r.% 1000.0) (r.> 0.0)] - ["Real/Min" R;real Number<Real> Order<Real> Min@Monoid<Real> (r.% 1000.0) (r.> 0.0)] - ["Real/Max" R;real Number<Real> Order<Real> Max@Monoid<Real> (r.% 1000.0) (r.> 0.0)] + ["Frac/Add" R;frac Number<Frac> Order<Frac> Add@Monoid<Frac> (f.% 1000.0) (f.> 0.0)] + ["Frac/Mul" R;frac Number<Frac> Order<Frac> Mul@Monoid<Frac> (f.% 1000.0) (f.> 0.0)] + ["Frac/Min" R;frac Number<Frac> Order<Frac> Min@Monoid<Frac> (f.% 1000.0) (f.> 0.0)] + ["Frac/Max" R;frac Number<Frac> Order<Frac> Max@Monoid<Frac> (f.% 1000.0) (f.> 0.0)] ["Deg/Add" R;deg Number<Deg> Order<Deg> Add@Monoid<Deg> (d.% .125) (function [_] true)] ## ["Deg/Mul" R;deg Number<Deg> Order<Deg> Mul@Monoid<Deg> (d.% .125) (function [_] true)] ["Deg/Min" R;deg Number<Deg> Order<Deg> Min@Monoid<Deg> (d.% .125) (function [_] true)] @@ -137,15 +137,15 @@ ["Deg/Decimal" R;deg Eq<Deg> Codec<Text,Deg>] ["Deg/Hex" R;deg Eq<Deg> Hex@Codec<Text,Deg>] - ["Real/Binary" R;real Eq<Real> Binary@Codec<Text,Real>] - ["Real/Octal" R;real Eq<Real> Octal@Codec<Text,Real>] - ["Real/Decimal" R;real Eq<Real> Codec<Text,Real>] - ["Real/Hex" R;real Eq<Real> Hex@Codec<Text,Real>] + ["Frac/Binary" R;frac Eq<Frac> Binary@Codec<Text,Frac>] + ["Frac/Octal" R;frac Eq<Frac> Octal@Codec<Text,Frac>] + ["Frac/Decimal" R;frac Eq<Frac> Codec<Text,Frac>] + ["Frac/Hex" R;frac Eq<Frac> Hex@Codec<Text,Frac>] ) -(context: "Can convert real values to/from their bit patterns." - [raw R;real +(context: "Can convert frac values to/from their bit patterns." + [raw R;frac factor (|> R;nat (:: @ map (|>. (n.% +1000) (n.max +1)))) - #let [sample (|> factor nat-to-int int-to-real (r.* raw))]] - (test "Can convert real values to/from their bit patterns." - (|> sample real-to-bits bits-to-real (r.= sample)))) + #let [sample (|> factor nat-to-int int-to-frac (f.* raw))]] + (test "Can convert frac values to/from their bit patterns." + (|> sample frac-to-bits bits-to-frac (f.= sample)))) diff --git a/stdlib/test/test/lux/data/number/complex.lux b/stdlib/test/test/lux/data/number/complex.lux index 52ad12afb..78155e061 100644 --- a/stdlib/test/test/lux/data/number/complex.lux +++ b/stdlib/test/test/lux/data/number/complex.lux @@ -6,7 +6,7 @@ (data [text "Text/" Monoid<Text>] text/format [bool "b/" Eq<Bool>] - [number "r/" Number<Real>] + [number "f/" Number<Frac>] ["&" number/complex] (coll [list "List/" Fold<List> Functor<List>]) [product]) @@ -17,23 +17,23 @@ ## Based on org.apache.commons.math4.complex.Complex ## https://github.com/apache/commons-math/blob/master/src/test/java/org/apache/commons/math4/complex/ComplexTest.java -(def: margin-of-error Real 1.0e-10) +(def: margin-of-error Frac 1.0e-10) (def: (within? margin standard value) - (-> Real &;Complex &;Complex Bool) - (let [real-dist (r/abs (r.- (get@ #&;real standard) + (-> Frac &;Complex &;Complex Bool) + (let [real-dist (f/abs (f.- (get@ #&;real standard) (get@ #&;real value))) - imgn-dist (r/abs (r.- (get@ #&;imaginary standard) + imgn-dist (f/abs (f.- (get@ #&;imaginary standard) (get@ #&;imaginary value)))] - (and (r.< margin real-dist) - (r.< margin imgn-dist)))) + (and (f.< margin real-dist) + (f.< margin imgn-dist)))) (def: gen-dim - (R;Random Real) + (R;Random Frac) (do R;Monad<Random> [factor (|> R;nat (:: @ map (|>. (n.% +1000) (n.max +1)))) - measure (|> R;real (R;filter (r.> 0.0)))] - (wrap (r.* (|> factor nat-to-int int-to-real) + measure (|> R;frac (R;filter (f.> 0.0)))] + (wrap (f.* (|> factor nat-to-int int-to-frac) measure)))) (def: gen-complex @@ -49,8 +49,8 @@ ($_ seq (test "Can build and tear apart complex numbers" (let [r+i (&;complex real imaginary)] - (and (r.= real (get@ #&;real r+i)) - (r.= 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 number;not-a-number imaginary)) @@ -64,18 +64,18 @@ (test "Absolute value of complex >= absolute value of any of the parts." (let [r+i (&;complex real imaginary) abs (get@ #&;real (&;c.abs r+i))] - (and (r.>= (r/abs real) abs) - (r.>= (r/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 (number;not-a-number? (get@ #&;real (&;c.abs (&;complex number;not-a-number imaginary)))) (number;not-a-number? (get@ #&;real (&;c.abs (&;complex real number;not-a-number)))))) (test "The absolute value of a complex number involving an infinity on either dimension, results in an infinite value." - (and (r.= number;positive-infinity (get@ #&;real (&;c.abs (&;complex number;positive-infinity imaginary)))) - (r.= number;positive-infinity (get@ #&;real (&;c.abs (&;complex real number;positive-infinity)))) - (r.= number;positive-infinity (get@ #&;real (&;c.abs (&;complex number;negative-infinity imaginary)))) - (r.= number;positive-infinity (get@ #&;real (&;c.abs (&;complex real number;negative-infinity)))))) + (and (f.= number;positive-infinity (get@ #&;real (&;c.abs (&;complex number;positive-infinity imaginary)))) + (f.= number;positive-infinity (get@ #&;real (&;c.abs (&;complex real number;positive-infinity)))) + (f.= number;positive-infinity (get@ #&;real (&;c.abs (&;complex number;negative-infinity imaginary)))) + (f.= number;positive-infinity (get@ #&;real (&;c.abs (&;complex real number;negative-infinity)))))) )) (context: "Addidion, substraction, multiplication and division" @@ -86,17 +86,17 @@ (test "Adding 2 complex numbers is the same as adding their parts." (let [z (&;c.+ y x)] (and (&;c.= z - (&;complex (r.+ (get@ #&;real y) + (&;complex (f.+ (get@ #&;real y) (get@ #&;real x)) - (r.+ (get@ #&;imaginary y) + (f.+ (get@ #&;imaginary y) (get@ #&;imaginary x))))))) (test "Subtracting 2 complex numbers is the same as adding their parts." (let [z (&;c.- y x)] (and (&;c.= z - (&;complex (r.- (get@ #&;real y) + (&;complex (f.- (get@ #&;real y) (get@ #&;real x)) - (r.- (get@ #&;imaginary y) + (f.- (get@ #&;imaginary y) (get@ #&;imaginary x))))))) (test "Subtraction is the inverse of addition." @@ -126,9 +126,9 @@ ($_ seq (test "Conjugate has same real part as original, and opposite of imaginary part." (let [cx (&;conjugate x)] - (and (r.= (get@ #&;real x) + (and (f.= (get@ #&;real x) (get@ #&;real cx)) - (r.= (r/negate (get@ #&;imaginary x)) + (f.= (f/negate (get@ #&;imaginary x)) (get@ #&;imaginary cx))))) (test "The reciprocal functions is its own inverse." @@ -139,9 +139,9 @@ (test "Absolute value of signum is always root2(2), 1 or 0." (let [signum-abs (|> x &;c.signum &;c.abs (get@ #&;real))] - (or (r.= 0.0 signum-abs) - (r.= 1.0 signum-abs) - (r.= (math;root2 2.0) signum-abs)))) + (or (f.= 0.0 signum-abs) + (f.= 1.0 signum-abs) + (f.= (math;root2 2.0) signum-abs)))) (test "Negation is its own inverse." (let [there (&;c.negate x) @@ -150,7 +150,7 @@ (&;c.= back-again x)))) (test "Negation doesn't change the absolute value." - (r.= (get@ #&;real (&;c.abs x)) + (f.= (get@ #&;real (&;c.abs x)) (get@ #&;real (&;c.abs (&;c.negate x))))) )) @@ -184,7 +184,7 @@ (test "Can calculate the N roots for any complex number." (|> sample (&;nth-roots degree) - (List/map (&;pow' (|> degree nat-to-int int-to-real))) + (List/map (&;pow' (|> degree nat-to-int int-to-frac))) (list;every? (within? margin-of-error sample))))) (context: "Codec" diff --git a/stdlib/test/test/lux/data/number/ratio.lux b/stdlib/test/test/lux/data/number/ratio.lux index 968f38b96..a2eb4f53d 100644 --- a/stdlib/test/test/lux/data/number/ratio.lux +++ b/stdlib/test/test/lux/data/number/ratio.lux @@ -6,7 +6,6 @@ (data [text "Text/" Monoid<Text>] text/format [bool "b/" Eq<Bool>] - [number "r/" Number<Real>] ["&" number/ratio "&/" Number<Ratio>] (coll [list "List/" Fold<List> Functor<List>]) [product]) diff --git a/stdlib/test/test/lux/host.js.lux b/stdlib/test/test/lux/host.js.lux index 92ac8ddb4..93e90bbfe 100644 --- a/stdlib/test/test/lux/host.js.lux +++ b/stdlib/test/test/lux/host.js.lux @@ -25,7 +25,7 @@ (test "Can call JavaScript functions" (and (is 124.0 - (&;call! (&;ref "Math.ceil" &;Function) [123.45] Real)) + (&;call! (&;ref "Math.ceil" &;Function) [123.45] Frac)) (is 124.0 - (&;call! (&;ref "Math") "ceil" [123.45] Real)))) + (&;call! (&;ref "Math") "ceil" [123.45] Frac)))) )) diff --git a/stdlib/test/test/lux/macro/code.lux b/stdlib/test/test/lux/macro/code.lux index c01a370a2..ff21fd0c9 100644 --- a/stdlib/test/test/lux/macro/code.lux +++ b/stdlib/test/test/lux/macro/code.lux @@ -19,7 +19,7 @@ [(&;bool true) "true"] [(&;bool false) "false"] [(&;int 123) "123"] - [(&;real 123.0) "123.0"] + [(&;frac 123.0) "123.0"] [(&;text "\n") "\"\\n\""] [(&;tag ["yolo" "lol"]) "#yolo;lol"] [(&;symbol ["yolo" "lol"]) "yolo;lol"] diff --git a/stdlib/test/test/lux/macro/poly/eq.lux b/stdlib/test/test/lux/macro/poly/eq.lux index 367ac1674..525b668a8 100644 --- a/stdlib/test/test/lux/macro/poly/eq.lux +++ b/stdlib/test/test/lux/macro/poly/eq.lux @@ -19,29 +19,29 @@ (type: Variant (#Case0 Bool) (#Case1 Int) - (#Case2 Real)) + (#Case2 Frac)) (type: #rec Recursive - (#Number Real) - (#Addition Real Recursive)) + (#Number Frac) + (#Addition Frac Recursive)) (type: Record {#unit Unit #bool Bool #int Int - #real Real + #frac Frac #text Text #maybe (Maybe Int) #list (List Int) #variant Variant - #tuple [Int Real Text] + #tuple [Int Frac Text] #recursive Recursive}) (def: gen-recursive (r;Random Recursive) (r;rec (function [gen-recursive] - (r;alt r;real - (r;seq r;real gen-recursive))))) + (r;alt r;frac + (r;seq r;frac gen-recursive))))) (def: gen-record (r;Random Record) @@ -52,12 +52,12 @@ (:: @ wrap []) r;bool gen-int - r;real + r;frac (r;text size) (r;maybe gen-int) (r;list size gen-int) - ($_ r;alt r;bool gen-int r;real) - ($_ r;seq gen-int r;real (r;text size)) + ($_ r;alt r;bool gen-int r;frac) + ($_ r;seq gen-int r;frac (r;text size)) gen-recursive))) (derived: (&;Eq<?> Record)) diff --git a/stdlib/test/test/lux/macro/syntax.lux b/stdlib/test/test/lux/macro/syntax.lux index 2d4f771d2..e988a0103 100644 --- a/stdlib/test/test/lux/macro/syntax.lux +++ b/stdlib/test/test/lux/macro/syntax.lux @@ -74,7 +74,7 @@ ["Can parse Nat syntax." +123 code;nat number;Eq<Nat> s;nat] ["Can parse Int syntax." 123 code;int number;Eq<Int> s;int] ["Can parse Deg syntax." .123 code;deg number;Eq<Deg> s;deg] - ["Can parse Real syntax." 123.0 code;real number;Eq<Real> s;real] + ["Can parse Frac syntax." 123.0 code;frac number;Eq<Frac> s;frac] ["Can parse Text syntax." "\n" code;text text;Eq<Text> s;text] ["Can parse Symbol syntax." ["yolo" "lol"] code;symbol ident;Eq<Ident> s;symbol] ["Can parse Tag syntax." ["yolo" "lol"] code;tag ident;Eq<Ident> s;tag] @@ -115,7 +115,7 @@ (match (#;Right 123) (p;run (list (<ctor> (list (code;int 123)))) (<parser> (p;alt s;bool s;int)))) - (fails? (p;run (list (<ctor> (list (code;real 123.0)))) + (fails? (p;run (list (<ctor> (list (code;frac 123.0)))) (<parser> (p;alt s;bool s;int))))))] ["form" s;form code;form] diff --git a/stdlib/test/test/lux/math.lux b/stdlib/test/test/lux/math.lux index f3cdb0666..63a449965 100644 --- a/stdlib/test/test/lux/math.lux +++ b/stdlib/test/test/lux/math.lux @@ -5,7 +5,7 @@ (data [text "Text/" Monoid<Text>] text/format [bool "b/" Eq<Bool>] - [number "r/" Number<Real>] + [number "f/" Number<Frac>] (coll [list "List/" Fold<List> Functor<List>]) [product]) ["R" math/random] @@ -13,17 +13,17 @@ lux/test) (def: (within? margin-of-error standard value) - (-> Real Real Real Bool) - (r.< margin-of-error - (r/abs (r.- standard value)))) + (-> Frac Frac Frac Bool) + (f.< margin-of-error + (f/abs (f.- standard value)))) -## (def: margin Real 0.0000001) +## (def: margin Frac 0.0000001) ## ## The JVM trigonometry functions sometimes give me funky results. ## ## I won't be testing this, until I can figure out what's going on, or ## ## come up with my own implementation ## (context: "Trigonometry" -## [angle (|> R;real (:: @ map (r.* &;tau)))] +## [angle (|> R;frac (:: @ map (f.* &;tau)))] ## ($_ seq ## (test "Sine and arc-sine are inverse functions." ## (|> angle &;sin &;asin (within? margin angle))) @@ -39,39 +39,39 @@ [factor (|> R;nat (:: @ map (|>. (n.% +1000) (n.max +1) nat-to-int - int-to-real))) - base (|> R;real (:: @ map (r.* factor)))] + int-to-frac))) + base (|> R;frac (:: @ map (f.* factor)))] ($_ seq (test "Square-root is inverse of square." - (|> base (&;pow 2.0) &;root2 (r.= base))) + (|> base (&;pow 2.0) &;root2 (f.= base))) (test "Cubic-root is inverse of cube." - (|> base (&;pow 3.0) &;root3 (r.= base))) + (|> base (&;pow 3.0) &;root3 (f.= base))) )) (context: "Rounding" - [sample (|> R;real (:: @ map (r.* 1000.0)))] + [sample (|> R;frac (:: @ map (f.* 1000.0)))] ($_ seq (test "The ceiling will be an integer value, and will be >= the original." (let [ceil'd (&;ceil sample)] - (and (|> ceil'd real-to-int int-to-real (r.= ceil'd)) - (r.>= sample ceil'd) - (r.<= 1.0 (r.- sample ceil'd))))) + (and (|> ceil'd frac-to-int int-to-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 real-to-int int-to-real (r.= floor'd)) - (r.<= sample floor'd) - (r.<= 1.0 (r.- floor'd sample))))) + (and (|> floor'd frac-to-int int-to-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 real-to-int int-to-real (r.= round'd)) - (r.<= 1.0 (r/abs (r.- sample round'd)))))) + (and (|> round'd frac-to-int int-to-frac (f.= round'd)) + (f.<= 1.0 (f/abs (f.- sample round'd)))))) )) (context: "Exponentials and logarithms" - [sample (|> R;real (:: @ map (r.* 10.0)))] + [sample (|> R;frac (:: @ map (f.* 10.0)))] (test "Logarithm is the inverse of exponential." (|> sample &;exp &;log (within? 1.0e-15 sample)))) diff --git a/stdlib/test/test/lux/math/logic/fuzzy.lux b/stdlib/test/test/lux/math/logic/fuzzy.lux index bb27a435d..5f10696c1 100644 --- a/stdlib/test/test/lux/math/logic/fuzzy.lux +++ b/stdlib/test/test/lux/math/logic/fuzzy.lux @@ -48,7 +48,7 @@ (<gte> top sample)))) ))] - ["Real" number;Hash<Real> R;real &;r.triangle r.< r.<= r.> r.>=] + ["Frac" number;Hash<Frac> R;frac &;f.triangle f.< f.<= f.> f.>=] ["Deg" number;Hash<Deg> R;deg &;d.triangle d.< d.<= d.> d.>=] ) @@ -94,29 +94,29 @@ (<gte> top sample)))) ))] - ["Real" number;Hash<Real> R;real &;r.trapezoid r.< r.<= r.> r.>=] + ["Frac" number;Hash<Frac> R;frac &;f.trapezoid f.< f.<= f.> f.>=] ["Deg" number;Hash<Deg> R;deg &;d.trapezoid d.< d.<= d.> d.>=] ) (context: "Gaussian" - [deviation (|> R;real (R;filter (r.> 0.0))) - center R;real + [deviation (|> R;frac (R;filter (f.> 0.0))) + center R;frac #let [gaussian (&;gaussian deviation center)]] (test "The center value will always have maximum membership." (d.= ~true (&;membership center gaussian)))) (def: gen-triangle - (R;Random (&;Fuzzy Real)) + (R;Random (&;Fuzzy Frac)) (do R;Monad<Random> - [x R;real - y R;real - z R;real] - (wrap (&;r.triangle x y z)))) + [x R;frac + y R;frac + z R;frac] + (wrap (&;f.triangle x y z)))) (context: "Combinators" [left gen-triangle right gen-triangle - sample R;real] + sample R;frac] ($_ seq (test "Union membership as as high as membership in any of its members." (let [combined (&;union left right) @@ -162,7 +162,7 @@ (context: "Thresholds" [fuzzy gen-triangle - sample R;real + sample R;frac threshold R;deg #let [vip-fuzzy (&;cut threshold fuzzy) member? (&;to-predicate threshold fuzzy)]] |