diff options
Diffstat (limited to '')
24 files changed, 258 insertions, 276 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index d68ef26ad..6ec614fb5 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -116,9 +116,9 @@ [dummy-cursor (+5 "Your standard, run-of-the-mill integer numbers.")]] #Nil))))]) -("lux def" Deg - (+10 ["lux" "Deg"] - (+0 "#I64" (#Cons (+0 "#Deg" #Nil) #Nil))) +("lux def" Rev + (+10 ["lux" "Rev"] + (+0 "#I64" (#Cons (+0 "#Rev" #Nil) #Nil))) [dummy-cursor (+10 (#Cons [[dummy-cursor (+7 ["lux" "type?"])] [dummy-cursor (+0 true)]] @@ -309,7 +309,7 @@ ## (#Bool Bool) ## (#Nat Nat) ## (#Int Int) -## (#Deg Deg) +## (#Rev Rev) ## (#Frac Frac) ## (#Text Text) ## (#Symbol Text Text) @@ -332,8 +332,8 @@ Nat (#Sum ## "lux.Int" Int - (#Sum ## "lux.Deg" - Deg + (#Sum ## "lux.Rev" + Rev (#Sum ## "lux.Frac" Frac (#Sum ## "lux.Text" @@ -355,7 +355,7 @@ [dummy-cursor (+9 (#Cons [dummy-cursor (+5 "Bool")] (#Cons [dummy-cursor (+5 "Nat")] (#Cons [dummy-cursor (+5 "Int")] - (#Cons [dummy-cursor (+5 "Deg")] + (#Cons [dummy-cursor (+5 "Rev")] (#Cons [dummy-cursor (+5 "Frac")] (#Cons [dummy-cursor (+5 "Text")] (#Cons [dummy-cursor (+5 "Symbol")] @@ -411,9 +411,9 @@ ("lux function" _ value (_ann (#Int value)))) [dummy-cursor (#Record #Nil)]) -("lux def" deg$ - ("lux check" (#Function Deg Code) - ("lux function" _ value (_ann (#Deg value)))) +("lux def" rev$ + ("lux check" (#Function Rev Code) + ("lux function" _ value (_ann (#Rev value)))) [dummy-cursor (#Record #Nil)]) ("lux def" frac$ @@ -1900,8 +1900,8 @@ [_ [_ (#Int value)]] (return (wrap-meta (form$ (list (tag$ ["lux" "Int"]) (int$ value))))) - [_ [_ (#Deg value)]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Deg"]) (deg$ value))))) + [_ [_ (#Rev value)]] + (return (wrap-meta (form$ (list (tag$ ["lux" "Rev"]) (rev$ value))))) [_ [_ (#Frac value)]] (return (wrap-meta (form$ (list (tag$ ["lux" "Frac"]) (frac$ value))))) @@ -2294,39 +2294,39 @@ _ (fail "Wrong syntax for do-template")})) -(def:''' #export (d/= test subject) +(def:''' #export (r/= test subject) (list [(tag$ ["lux" "doc"]) - (text$ "Deg(ree) equality.")]) - (-> Deg Deg Bool) + (text$ "Rev(olution) equality.")]) + (-> Rev Rev Bool) ("lux i64 =" test subject)) -(def:''' #export (d/< test subject) +(def:''' #export (r/< test subject) (list [(tag$ ["lux" "doc"]) - (text$ "Deg(ree) less-than.")]) - (-> Deg Deg Bool) + (text$ "Rev(olution) less-than.")]) + (-> Rev Rev Bool) (n/< ("lux coerce" Nat test) ("lux coerce" Nat subject))) -(def:''' #export (d/<= test subject) +(def:''' #export (r/<= test subject) (list [(tag$ ["lux" "doc"]) - (text$ "Deg(ree) less-than-equal.")]) - (-> Deg Deg Bool) + (text$ "Rev(olution) less-than-equal.")]) + (-> Rev Rev Bool) (if (n/< ("lux coerce" Nat test) ("lux coerce" Nat subject)) true ("lux i64 =" test subject))) -(def:''' #export (d/> test subject) +(def:''' #export (r/> test subject) (list [(tag$ ["lux" "doc"]) - (text$ "Deg(ree) greater-than.")]) - (-> Deg Deg Bool) - (d/< subject test)) + (text$ "Rev(olution) greater-than.")]) + (-> Rev Rev Bool) + (r/< subject test)) -(def:''' #export (d/>= test subject) +(def:''' #export (r/>= test subject) (list [(tag$ ["lux" "doc"]) - (text$ "Deg(ree) greater-than-equal.")]) - (-> Deg Deg Bool) - (if (d/< subject test) + (text$ "Rev(olution) greater-than-equal.")]) + (-> Rev Rev Bool) + (if (r/< subject test) true ("lux i64 =" test subject))) @@ -2424,8 +2424,8 @@ [ Int i/+ "lux i64 +" "Int(eger) addition."] [ Int i/- "lux i64 -" "Int(eger) substraction."] - [ Deg d/+ "lux i64 +" "Deg(ree) addition."] - [ Deg d/- "lux i64 -" "Deg(ree) substraction."] + [ Rev r/+ "lux i64 +" "Rev(olution) addition."] + [ Rev r/- "lux i64 -" "Rev(olution) substraction."] ) (do-template [<type> <name> <op> <doc>] @@ -2446,10 +2446,10 @@ [Frac f/% "lux frac %" "Frac(tion) remainder."] ) -(def:''' #export (d/* param subject) +(def:''' #export (r/* param subject) (list [(tag$ ["lux" "doc"]) - (text$ "Deg(ree) multiplication.")]) - (-> Deg Deg Deg) + (text$ "Rev(olution) multiplication.")]) + (-> Rev Rev Rev) (let' [subjectH (high-bits subject) subjectL (low-bits subject) paramH (high-bits param) @@ -2479,12 +2479,12 @@ ("lux i64 logical-right-shift" +1 remaining)) [count remaining])) -(def:''' #export (d// param subject) +(def:''' #export (r// param subject) (list [(tag$ ["lux" "doc"]) - (text$ "Deg(ree) division.")]) - (-> Deg Deg Deg) + (text$ "Rev(olution) division.")]) + (-> Rev Rev Rev) (if ("lux i64 =" 0 param) - ("lux io error" "Cannot divide Deg by zero!") + ("lux io error" "Cannot divide Rev by zero!") (let' [[trailing-zeroes remaining] (without-trailing-zeroes +0 ("lux coerce" Nat param)) [trailing-zeroes denominator] ("lux check" (#Product Nat Nat) (if ("lux i64 =" 0 trailing-zeroes) @@ -2492,35 +2492,35 @@ [trailing-zeroes remaining])) shift ("lux i64 -" trailing-zeroes +64) numerator ("lux i64 left-shift" shift +1)] - ("lux coerce" Deg + ("lux coerce" Rev ("lux int *" ("lux coerce" Int subject) ("lux int /" ("lux coerce" Int numerator) ("lux coerce" Int denominator))))))) -(def:''' #export (d/% param subject) +(def:''' #export (r/% param subject) (list [(tag$ ["lux" "doc"]) - (text$ "Deg(ree) remainder.")]) - (-> Deg Deg Deg) - ("lux coerce" Deg + (text$ "Rev(olution) remainder.")]) + (-> Rev Rev Rev) + ("lux coerce" Rev (n/% ("lux coerce" Nat subject) ("lux coerce" Nat param)))) -(def:''' #export (d/scale param subject) +(def:''' #export (r/scale param subject) (list [(tag$ ["lux" "doc"]) - (text$ "Deg(ree) scale.")]) - (-> Nat Deg Deg) - ("lux coerce" Deg + (text$ "Rev(olution) scale.")]) + (-> Nat Rev Rev) + ("lux coerce" Rev ("lux int *" ("lux coerce" Int subject) ("lux coerce" Int param)))) -(def:''' #export (d/reciprocal numerator) +(def:''' #export (r/reciprocal numerator) (list [(tag$ ["lux" "doc"]) - (text$ "Deg(ree) reciprocal of a Nat(ural).")]) - (-> Nat Deg) - ("lux coerce" Deg + (text$ "Rev(olution) reciprocal of a Nat(ural).")]) + (-> Nat Rev) + ("lux coerce" Rev (let' [[trailing-zeroes remaining] (without-trailing-zeroes +0 numerator)] (n// remaining ("lux case" trailing-zeroes @@ -2542,8 +2542,8 @@ [i/min Int i/< "Int(eger) minimum."] [i/max Int i/> "Int(eger) maximum."] - [d/min Deg d/< "Deg(ree) minimum."] - [d/max Deg d/> "Deg(ree) maximum."] + [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."] @@ -3053,7 +3053,7 @@ [_ (#Int value)] (int/encode value) - [_ (#Deg value)] + [_ (#Rev value)] ("lux io error" "Undefined behavior.") [_ (#Frac value)] @@ -3285,8 +3285,8 @@ [_ (#Int value)] (meta-code ["lux" "Int"] (int$ value)) - [_ (#Deg value)] - (meta-code ["lux" "Deg"] (deg$ value)) + [_ (#Rev value)] + (meta-code ["lux" "Rev"] (rev$ value)) [_ (#Frac value)] (meta-code ["lux" "Frac"] (frac$ value)) @@ -5267,7 +5267,7 @@ ([#Bool] [#Nat] [#Int] - [#Deg] + [#Rev] [#Frac] [#Text] [#Symbol] @@ -5334,7 +5334,7 @@ [i64 I64] [nat Nat] [int Int] - [deg Deg] + [rev Rev] ) (def: (repeat n x) @@ -5400,7 +5400,7 @@ [#Tuple "[" "]" id] [#Record "{" "}" rejoin-all-pairs]) - [new-cursor (#Deg value)] + [new-cursor (#Rev value)] ("lux io error" "Undefined behavior.") )) @@ -5589,7 +5589,7 @@ (def: (place-tokens label tokens target) (-> Text (List Code) Code (Maybe (List Code))) (case target - (^or [_ (#Bool _)] [_ (#Nat _)] [_ (#Int _)] [_ (#Deg _)] [_ (#Frac _)] [_ (#Text _)] [_ (#Tag _)]) + (^or [_ (#Bool _)] [_ (#Nat _)] [_ (#Int _)] [_ (#Rev _)] [_ (#Frac _)] [_ (#Text _)] [_ (#Tag _)]) (#Some (list target)) [_ (#Symbol [prefix name])] @@ -5682,7 +5682,7 @@ (["Bool"] ["Nat"] ["Int"] - ["Deg"] + ["Rev"] ["Frac"] ["Text"]) @@ -5704,7 +5704,7 @@ (["Bool" Bool bool$] ["Nat" Nat nat$] ["Int" Int int$] - ["Deg" Deg deg$] + ["Rev" Rev rev$] ["Frac" Frac frac$] ["Text" Text text$]) @@ -6227,7 +6227,7 @@ ([#Bool "Bool" bool$] [#Nat "Nat" nat$] [#Int "Int" int$] - [#Deg "Deg" deg$] + [#Rev "Rev" rev$] [#Frac "Frac" frac$] [#Text "Text" text$] [#Tag "Tag" ident$] @@ -6304,7 +6304,7 @@ (<%> param subject)])] [Int i//% i// i/%] - [Deg d//% d// d/%] + [Rev r//% r// r/%] [Frac f//% f// f/%] ) @@ -6313,22 +6313,22 @@ (|>> ("lux i64 logical-right-shift" +11) int-to-frac)) -(def: deg-denominator Frac (to-significand -1)) +(def: rev-denominator Frac (to-significand -1)) -(def: #export (frac-to-deg input) - (-> Frac Deg) +(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/* deg-denominator) + (f/* rev-denominator) frac-to-int ("lux i64 left-shift" +11)))) -(def: #export deg-to-frac - (-> Deg Frac) - (|>> to-significand (f// deg-denominator))) +(def: #export rev-to-frac + (-> Rev Frac) + (|>> to-significand (f// rev-denominator))) (macro: #export (alias: tokens) (case tokens diff --git a/stdlib/source/lux/control/concatenative.lux b/stdlib/source/lux/control/concatenative.lux index 70756c5c6..fb1e903b2 100644 --- a/stdlib/source/lux/control/concatenative.lux +++ b/stdlib/source/lux/control/concatenative.lux @@ -1,7 +1,7 @@ (.module: [lux #- if loop when 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]) @@ -98,7 +98,7 @@ (case command (^or [_ (#.Bool _)] [_ (#.Nat _)] [_ (#.Int _)] - [_ (#.Deg _)] [_ (#.Frac _)] + [_ (#.Rev _)] [_ (#.Frac _)] [_ (#.Text _)] [_ (#.Tag _)] (^ [_ (#.Form (list [_ (#.Tag _)]))])) (` (..push (~ command))) @@ -222,16 +222,16 @@ [Int Bool i/> .i/>] [Int Bool i/>= .i/>=] - [Deg Deg d/+ .d/+] - [Deg Deg d/- .d/-] - [Deg Deg d/* .d/*] - [Deg Deg d// .d//] - [Deg Deg d/% .d/%] - [Deg Bool d/= .d/=] - [Deg Bool d/< .d/<] - [Deg Bool d/<= .d/<=] - [Deg Bool d/> .d/>] - [Deg Bool d/>= .d/>=] + [Rev Rev r/+ .r/+] + [Rev Rev r/- .r/-] + [Rev Rev r/* .r/*] + [Rev Rev r// .r//] + [Rev Rev r/% .r/%] + [Rev Bool r/= .r/=] + [Rev Bool r/< .r/<] + [Rev Bool r/<= .r/<=] + [Rev Bool r/> .r/>] + [Rev Bool r/>= .r/>=] [Frac Frac f/+ .f/+] [Frac Frac f/- .f/-] diff --git a/stdlib/source/lux/data/format/css.lux b/stdlib/source/lux/data/format/css.lux index 360ef416f..d76242045 100644 --- a/stdlib/source/lux/data/format/css.lux +++ b/stdlib/source/lux/data/format/css.lux @@ -46,14 +46,14 @@ ")"))) (def: #export (rgba color alpha) - (-> Color Deg Value) + (-> Color Rev Value) (let [[red green blue] (color.unpack color)] (format "rgba(" (|> red .int %i) "," (|> green .int %i) "," (|> blue .int %i) - "," (if (d/= (:: number.Interval<Deg> top) alpha) + "," (if (r/= (:: number.Interval<Rev> top) alpha) "1.0" - (format "0" (%d alpha))) + (format "0" (%r alpha))) ")"))) (def: #export (rule selector style children) diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index 4ac938ac2..8c9e663cb 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/=] + [ Rev r/=] [Frac f/=] ) @@ -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/>=] + [Rev Eq<Rev> r/< r/<= r/> r/>=] [Frac Eq<Frac> f/< f/<= f/> f/>=] ) @@ -74,16 +74,16 @@ [Frac Order<Frac> f/+ f/- f/* f// f/% f/= f/< 0.0 1.0 -1.0] ) -(struct: #export _ (Number Deg) - (def: + d/+) - (def: - d/-) - (def: * d/*) - (def: / d//) - (def: % d/%) - (def: (negate x) (d/- x (:coerce Deg -1))) +(struct: #export _ (Number Rev) + (def: + r/+) + (def: - r/-) + (def: * r/*) + (def: / r//) + (def: % r/%) + (def: (negate x) (r/- x (:coerce Rev -1))) (def: abs id) (def: (signum x) - (:coerce Deg -1))) + (:coerce Rev -1))) (do-template [<type> <order> <succ> <pred>] [(struct: #export _ (Enum <type>) @@ -94,7 +94,7 @@ [Nat Order<Nat> inc dec] [Int Order<Int> inc dec] [Frac Order<Frac> (f/+ ("lux frac smallest")) (f/- ("lux frac smallest"))] - [Deg Order<Deg> inc dec] + [Rev Order<Rev> inc dec] ) (do-template [<type> <enum> <top> <bottom>] @@ -106,7 +106,7 @@ [ Nat Enum<Nat> (:coerce Nat -1) +0] [ Int Enum<Int> 9_223_372_036_854_775_807 -9_223_372_036_854_775_808] [Frac Enum<Frac> ("lux frac max") ("lux frac min")] - [ Deg Enum<Deg> (:coerce Deg -1) (:coerce Deg +0)] + [ Rev Enum<Rev> (:coerce Rev -1) (:coerce Rev +0)] ) (do-template [<name> <type> <identity> <compose>] @@ -126,10 +126,10 @@ [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] - [ Min@Monoid<Deg> Deg (:: Interval<Deg> top) d/min] + [ Add@Monoid<Rev> Rev (:: Interval<Rev> bottom) r/+] + [ Mul@Monoid<Rev> Rev (:: Interval<Rev> top) r/*] + [ Max@Monoid<Rev> Rev (:: Interval<Rev> bottom) r/max] + [ Min@Monoid<Rev> Rev (:: Interval<Rev> top) r/min] ) (do-template [<name> <numerator> <doc>] @@ -379,7 +379,7 @@ (maybe.assume ("lux text clip" input +1 ("lux text size" input)))) (do-template [<struct> <nat> <char-bit-size> <error>] - [(struct: #export <struct> (Codec Text Deg) + [(struct: #export <struct> (Codec Text Rev) (def: (encode value) (let [raw-output (de-prefix (:: <nat> encode (:coerce Nat value))) max-num-chars (n// <char-bit-size> +64) @@ -400,15 +400,15 @@ (^multi (^ (#.Some (char "."))) [(:: <nat> decode ("lux text concat" "+" (de-prefix repr))) (#e.Success output)]) - (#e.Success (:coerce Deg output)) + (#e.Success (:coerce Rev output)) _ (#e.Error ("lux text concat" <error> repr))) (#e.Error ("lux text concat" <error> repr))))))] - [Binary@Codec<Text,Deg> Binary@Codec<Text,Nat> +1 "Invalid binary syntax: "] - [Octal@Codec<Text,Deg> Octal@Codec<Text,Nat> +3 "Invalid octal syntax: "] - [Hex@Codec<Text,Deg> Hex@Codec<Text,Nat> +4 "Invalid hexadecimal syntax: "] + [Binary@Codec<Text,Rev> Binary@Codec<Text,Nat> +1 "Invalid binary syntax: "] + [Octal@Codec<Text,Rev> Octal@Codec<Text,Nat> +3 "Invalid octal syntax: "] + [Hex@Codec<Text,Rev> Hex@Codec<Text,Nat> +4 "Invalid hexadecimal syntax: "] ) (do-template [<struct> <int> <base> <char-set> <error>] @@ -449,9 +449,9 @@ (recur (dec muls-left) (f/* <base> output)))) adjusted-decimal (|> decimal int-to-frac (f// div-power)) - dec-deg (case (:: Hex@Codec<Text,Deg> decode ("lux text concat" "." decimal-part)) - (#e.Success dec-deg) - dec-deg + dec-rev (case (:: Hex@Codec<Text,Rev> decode ("lux text concat" "." decimal-part)) + (#e.Success dec-rev) + dec-rev (#e.Error error) (error! error))] @@ -652,7 +652,7 @@ (let [encoding ($_ "lux text concat" "Given syntax for a " encoding - " number, generates a Nat, an Int, a Deg or a Frac.") + " number, generates a Nat, an Int, a Rev or a Frac.") underscore "Allows for the presence of underscore in the numbers." description [cursor (#.Text ($_ "lux text concat" encoding "\n" @@ -677,7 +677,7 @@ (-> Text Text) ("lux text replace-all" number "_" "")) -(do-template [<macro> <nat> <int> <deg> <frac> <error> <doc>] +(do-template [<macro> <nat> <int> <rev> <frac> <error> <doc>] [(macro: #export (<macro> tokens state) {#.doc <doc>} (case tokens @@ -694,8 +694,8 @@ (#e.Success [state (list [meta (#.Int value)])]) (^multi (#e.Error _) - [(:: <deg> decode repr) (#e.Success value)]) - (#e.Success [state (list [meta (#.Deg value)])]) + [(:: <rev> decode repr) (#e.Success value)]) + (#e.Success [state (list [meta (#.Rev value)])]) (^multi (#e.Error _) [(:: <frac> decode repr) (#e.Success value)]) @@ -707,21 +707,21 @@ _ (#e.Error <error>)))] - [bin Binary@Codec<Text,Nat> Binary@Codec<Text,Int> Binary@Codec<Text,Deg> Binary@Codec<Text,Frac> + [bin Binary@Codec<Text,Nat> Binary@Codec<Text,Int> Binary@Codec<Text,Rev> Binary@Codec<Text,Frac> "Invalid binary syntax." (encoding-doc "binary" (bin "11001001") (bin "11_00_10_01"))] - [oct Octal@Codec<Text,Nat> Octal@Codec<Text,Int> Octal@Codec<Text,Deg> Octal@Codec<Text,Frac> + [oct Octal@Codec<Text,Nat> Octal@Codec<Text,Int> Octal@Codec<Text,Rev> Octal@Codec<Text,Frac> "Invalid octal syntax." (encoding-doc "octal" (oct "615243") (oct "615_243"))] - [hex Hex@Codec<Text,Nat> Hex@Codec<Text,Int> Hex@Codec<Text,Deg> Hex@Codec<Text,Frac> + [hex Hex@Codec<Text,Nat> Hex@Codec<Text,Int> Hex@Codec<Text,Rev> Hex@Codec<Text,Frac> "Invalid hexadecimal syntax." (encoding-doc "hexadecimal" (hex "deadBEEF") (hex "dead_BEEF"))] ) -## The following code allows one to encode/decode Deg numbers as text. -## This is not a simple algorithm, and it requires subverting the Deg +## The following code allows one to encode/decode Rev numbers as text. +## This is not a simple algorithm, and it requires subverting the Rev ## abstraction a bit. -## It takes into account the fact that Deg numbers are represented by +## It takes into account the fact that Rev numbers are represented by ## Lux as 64-bit integers. ## A valid way to model them is as Lux's Nat type. ## This is a somewhat hackish way to do things, but it allows one to @@ -853,7 +853,7 @@ (digits-sub-once! idx (digits-get idx param) output)) output))) -(struct: #export _ (Codec Text Deg) +(struct: #export _ (Codec Text Rev) (def: (encode input) (let [input (:coerce Nat input) last-idx (dec bit.width)] @@ -897,11 +897,11 @@ (recur (digits-sub! power digits) (inc idx) (bit.set (n/- idx (dec bit.width)) output)))) - (#e.Success (:coerce Deg output)))) + (#e.Success (:coerce Rev output)))) #.None - (#e.Error ("lux text concat" "Wrong syntax for Deg: " input))) - (#e.Error ("lux text concat" "Wrong syntax for Deg: " input)))) + (#e.Error ("lux text concat" "Wrong syntax for Rev: " input))) + (#e.Error ("lux text concat" "Wrong syntax for Rev: " input)))) )) (def: (log2 input) @@ -1007,6 +1007,6 @@ (def: hash frac-to-bits)) -(struct: #export _ (Hash Deg) - (def: eq Eq<Deg>) +(struct: #export _ (Hash Rev) + (def: eq Eq<Rev>) (def: hash (|>> (:coerce Nat)))) diff --git a/stdlib/source/lux/data/number/complex.lux b/stdlib/source/lux/data/number/complex.lux index 52cf8066f..792d2ce53 100644 --- a/stdlib/source/lux/data/number/complex.lux +++ b/stdlib/source/lux/data/number/complex.lux @@ -37,7 +37,7 @@ (or (number.not-a-number? (get@ #real complex)) (number.not-a-number? (get@ #imaginary complex)))) -(def: #export (c/= param input) +(def: #export (= param input) (-> Complex Complex Bool) (and (f/= (get@ #real param) (get@ #real input)) @@ -52,19 +52,19 @@ #imaginary (<op> (get@ #imaginary param) (get@ #imaginary input))})] - [c/+ f/+] - [c/- f/-] + [+ f/+] + [- f/-] ) (struct: #export _ (Eq Complex) - (def: = c/=)) + (def: = ..=)) -(def: #export c/negate +(def: #export negate (-> Complex Complex) (|>> (update@ #real frac/negate) (update@ #imaginary frac/negate))) -(def: #export c/signum +(def: #export signum (-> Complex Complex) (|>> (update@ #real frac/signum) (update@ #imaginary frac/signum))) @@ -73,14 +73,14 @@ (-> Complex Complex) (update@ #imaginary frac/negate)) -(def: #export (c/*' param input) +(def: #export (*' param input) (-> Frac Complex Complex) {#real (f/* param (get@ #real input)) #imaginary (f/* param (get@ #imaginary input))}) -(def: #export (c/* param input) +(def: #export (* param input) (-> Complex Complex Complex) {#real (f/- (f/* (get@ #imaginary param) (get@ #imaginary input)) @@ -91,7 +91,7 @@ (f/* (get@ #imaginary param) (get@ #real input)))}) -(def: #export (c// param input) +(def: #export (/ param input) (-> Complex Complex Complex) (let [(^slots [#real #imaginary]) param] (if (f/< (frac/abs imaginary) @@ -105,20 +105,20 @@ {#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) +(def: #export (/' param subject) (-> Frac Complex Complex) (let [(^slots [#real #imaginary]) subject] {#real (f// param real) #imaginary (f// param imaginary)})) -(def: #export (c/% param input) +(def: #export (% param input) (-> Complex Complex Complex) - (let [scaled (c// param input) + (let [scaled (/ param input) quotient (|> scaled (update@ #real math.floor) (update@ #imaginary math.floor))] - (c/- (c/* quotient param) - input))) + (- (* quotient param) + input))) (def: #export (cos subject) (-> Complex Complex) @@ -170,7 +170,7 @@ {#real (f// d (math.sinh r2)) #imaginary (f// d (math.sin i2))})) -(def: #export (c/abs subject) +(def: #export (abs subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject] (complex (if (f/< (frac/abs imaginary) @@ -188,16 +188,16 @@ )))) (struct: #export _ (Number Complex) - (def: + c/+) - (def: - c/-) - (def: * c/*) - (def: / c//) - (def: % c/%) + (def: + ..+) + (def: - ..-) + (def: * ..*) + (def: / ../) + (def: % ..%) (def: (negate x) (|> x (update@ #real frac/negate) (update@ #imaginary frac/negate))) - (def: abs c/abs) + (def: abs ..abs) (def: (signum x) (|> x (update@ #real frac/signum) @@ -213,7 +213,7 @@ (def: #export (log subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject] - {#real (|> subject c/abs (get@ #real) math.log) + {#real (|> subject ..abs (get@ #real) math.log) #imaginary (math.atan2 real imaginary)})) (do-template [<name> <type> <op>] @@ -221,8 +221,8 @@ (-> <type> Complex Complex) (|> input log (<op> param) exp))] - [pow Complex c/*] - [pow' Frac c/*'] + [pow Complex ..*] + [pow' Frac ..*'] ) (def: (copy-sign sign magnitude) @@ -231,7 +231,7 @@ (def: #export (root2 (^@ input (^slots [#real #imaginary]))) (-> Complex Complex) - (let [t (|> input c/abs (get@ #real) (f/+ (frac/abs real)) (f// 2.0) (math.pow 0.5))] + (let [t (|> input ..abs (get@ #real) (f/+ (frac/abs real)) (f// 2.0) (math.pow 0.5))] (if (f/>= 0.0 real) {#real t #imaginary (f// (f/* 2.0 t) @@ -242,7 +242,7 @@ (def: #export (root2-1z input) (-> Complex Complex) - (|> (complex 1.0) (c/- (c/* input input)) root2)) + (|> (complex 1.0) (- (* input input)) root2)) (def: #export (reciprocal (^slots [#real #imaginary])) (-> Complex Complex) @@ -262,25 +262,25 @@ (def: #export (acos input) (-> Complex Complex) (|> input - (c/+ (|> input root2-1z (c/* i))) + (+ (|> input root2-1z (* i))) log - (c/* (c/negate i)))) + (* (negate i)))) (def: #export (asin input) (-> Complex Complex) (|> input root2-1z - (c/+ (c/* i input)) + (+ (* i input)) log - (c/* (c/negate i)))) + (* (negate i)))) (def: #export (atan input) (-> Complex Complex) (|> input - (c/+ i) - (c// (c/- input i)) + (+ i) + (/ (- input i)) log - (c/* (c// (complex 2.0) i)))) + (* (/ (complex 2.0) i)))) (def: #export (argument (^slots [#real #imaginary])) (-> Complex Frac) @@ -291,7 +291,7 @@ (if (n/= +0 nth) (list) (let [r-nth (|> nth .int int-to-frac) - nth-root-of-abs (|> input c/abs (get@ #real) (math.pow (f// r-nth 1.0))) + 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.n/range +0 (dec nth)) diff --git a/stdlib/source/lux/data/number/ratio.lux b/stdlib/source/lux/data/number/ratio.lux index 9d241fe89..6d241064a 100644 --- a/stdlib/source/lux/data/number/ratio.lux +++ b/stdlib/source/lux/data/number/ratio.lux @@ -27,21 +27,21 @@ {#numerator (n// common numerator) #denominator (n// common denominator)})) -(def: #export (r/* param input) +(def: #export (* param input) (-> Ratio Ratio Ratio) (normalize [(n/* (get@ #numerator param) (get@ #numerator input)) (n/* (get@ #denominator param) (get@ #denominator input))])) -(def: #export (r// param input) +(def: #export (/ param input) (-> Ratio Ratio Ratio) (normalize [(n/* (get@ #denominator param) (get@ #numerator input)) (n/* (get@ #numerator param) (get@ #denominator input))])) -(def: #export (r/+ param input) +(def: #export (+ param input) (-> Ratio Ratio Ratio) (normalize [(n/+ (n/* (get@ #denominator input) (get@ #numerator param)) @@ -50,7 +50,7 @@ (n/* (get@ #denominator param) (get@ #denominator input))])) -(def: #export (r/- param input) +(def: #export (- param input) (-> Ratio Ratio Ratio) (normalize [(n/- (n/* (get@ #denominator input) (get@ #numerator param)) @@ -59,16 +59,16 @@ (n/* (get@ #denominator param) (get@ #denominator input))])) -(def: #export (r/% param input) +(def: #export (% param input) (-> Ratio Ratio Ratio) (let [quot (n// (n/* (get@ #denominator input) (get@ #numerator param)) (n/* (get@ #denominator param) (get@ #numerator input)))] - (r/- (update@ #numerator (n/* quot) param) - input))) + (- (update@ #numerator (n/* quot) param) + input))) -(def: #export (r/= param input) +(def: #export (= param input) (-> Ratio Ratio Bool) (and (n/= (get@ #numerator param) (get@ #numerator input)) @@ -83,10 +83,10 @@ (n/* (get@ #denominator param) (get@ #numerator input)))))] - [r/< n/<] - [r/<= n/<=] - [r/> n/>] - [r/>= n/>=] + [< n/<] + [<= n/<=] + [> n/>] + [>= n/>=] ) (do-template [<name> <comp>] @@ -96,26 +96,26 @@ right left))] - [r/min r/<] - [r/max r/>] + [min <] + [max >] ) (struct: #export _ (Eq Ratio) - (def: = r/=)) + (def: = ..=)) (struct: #export _ (order.Order Ratio) (def: eq Eq<Ratio>) - (def: < r/<) - (def: <= r/<=) - (def: > r/>) - (def: >= r/>=)) + (def: < ..<) + (def: <= ..<=) + (def: > ..>) + (def: >= ..>=)) (struct: #export _ (Number Ratio) - (def: + r/+) - (def: - r/-) - (def: * r/*) - (def: / r//) - (def: % r/%) + (def: + ..+) + (def: - ..-) + (def: * ..*) + (def: / ../) + (def: % ..%) (def: (negate (^slots [#numerator #denominator])) {#numerator denominator #denominator numerator}) diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux index b2a1c160c..847e4ac4f 100644 --- a/stdlib/source/lux/data/text/format.lux +++ b/stdlib/source/lux/data/text/format.lux @@ -38,7 +38,7 @@ [%b Bool (:: bool.Codec<Text,Bool> encode)] [%n Nat (:: number.Codec<Text,Nat> encode)] [%i Int (:: number.Codec<Text,Int> encode)] - [%d Deg (:: number.Codec<Text,Deg> encode)] + [%r Rev (:: number.Codec<Text,Rev> encode)] [%f Frac (:: number.Codec<Text,Frac> encode)] [%t Text text.encode] [%ident Ident (:: ident.Codec<Text,Ident> encode)] diff --git a/stdlib/source/lux/lang/compiler/analysis.lux b/stdlib/source/lux/lang/compiler/analysis.lux index 235e399fb..9d35ff92c 100644 --- a/stdlib/source/lux/lang/compiler/analysis.lux +++ b/stdlib/source/lux/lang/compiler/analysis.lux @@ -1,5 +1,5 @@ (.module: - [lux #- nat int deg] + [lux #- nat int rev] (lux (data [product] [error] [text "text/" Eq<Text>] @@ -13,7 +13,7 @@ (#Bool Bool) (#Nat Nat) (#Int Int) - (#Deg Deg) + (#Rev Rev) (#Frac Frac) (#Text Text)) @@ -73,7 +73,7 @@ [bool Bool #Bool] [nat Nat #Nat] [int Int #Int] - [deg Deg #Deg] + [rev Rev #Rev] [frac Frac #Frac] [text Text #Text] ) @@ -208,7 +208,7 @@ [pattern/bool #..Bool] [pattern/nat #..Nat] [pattern/int #..Int] - [pattern/deg #..Deg] + [pattern/rev #..Rev] [pattern/frac #..Frac] [pattern/text #..Text] ) diff --git a/stdlib/source/lux/lang/compiler/analysis/case.lux b/stdlib/source/lux/lang/compiler/analysis/case.lux index 84eb23af5..233ac114a 100644 --- a/stdlib/source/lux/lang/compiler/analysis/case.lux +++ b/stdlib/source/lux/lang/compiler/analysis/case.lux @@ -160,7 +160,7 @@ ([Bool (#.Bool pattern-value) (#//.Bool pattern-value)] [Nat (#.Nat pattern-value) (#//.Nat pattern-value)] [Int (#.Int pattern-value) (#//.Int pattern-value)] - [Deg (#.Deg pattern-value) (#//.Deg pattern-value)] + [Rev (#.Rev pattern-value) (#//.Rev pattern-value)] [Frac (#.Frac pattern-value) (#//.Frac pattern-value)] [Text (#.Text pattern-value) (#//.Text pattern-value)] [Any (#.Tuple #.Nil) #//.Unit]) diff --git a/stdlib/source/lux/lang/compiler/analysis/case/coverage.lux b/stdlib/source/lux/lang/compiler/analysis/case/coverage.lux index 6a965742a..3a63a76fc 100644 --- a/stdlib/source/lux/lang/compiler/analysis/case/coverage.lux +++ b/stdlib/source/lux/lang/compiler/analysis/case/coverage.lux @@ -80,7 +80,7 @@ (operation/wrap #Partial)) ([#///.Nat] [#///.Int] - [#///.Deg] + [#///.Rev] [#///.Frac] [#///.Text]) diff --git a/stdlib/source/lux/lang/compiler/analysis/expression.lux b/stdlib/source/lux/lang/compiler/analysis/expression.lux index 879f383e8..2ef2cae5b 100644 --- a/stdlib/source/lux/lang/compiler/analysis/expression.lux +++ b/stdlib/source/lux/lang/compiler/analysis/expression.lux @@ -43,7 +43,7 @@ ([#.Bool //primitive.bool] [#.Nat //primitive.nat] [#.Int //primitive.int] - [#.Deg //primitive.deg] + [#.Rev //primitive.rev] [#.Frac //primitive.frac] [#.Text //primitive.text]) diff --git a/stdlib/source/lux/lang/compiler/analysis/primitive.lux b/stdlib/source/lux/lang/compiler/analysis/primitive.lux index 74596fba2..5f6604926 100644 --- a/stdlib/source/lux/lang/compiler/analysis/primitive.lux +++ b/stdlib/source/lux/lang/compiler/analysis/primitive.lux @@ -1,5 +1,5 @@ (.module: - [lux #- nat int deg] + [lux #- nat int rev] (lux (control monad) [macro]) [// #+ Analysis] @@ -16,7 +16,7 @@ [bool Bool #//.Bool] [nat Nat #//.Nat] [int Int #//.Int] - [deg Deg #//.Deg] + [rev Rev #//.Rev] [frac Frac #//.Frac] [text Text #//.Text] ) diff --git a/stdlib/source/lux/lang/compiler/extension/analysis/common.lux b/stdlib/source/lux/lang/compiler/extension/analysis/common.lux index 9987bd369..3cd23ed17 100644 --- a/stdlib/source/lux/lang/compiler/extension/analysis/common.lux +++ b/stdlib/source/lux/lang/compiler/extension/analysis/common.lux @@ -175,23 +175,6 @@ (///bundle.install "to-frac" (unary Int Frac)) (///bundle.install "char" (unary Int Text))))) -(def: bundle/deg - ///.Bundle - (<| (///bundle.prefix "deg") - (|> ///.fresh - (///bundle.install "+" (binary Deg Deg Deg)) - (///bundle.install "-" (binary Deg Deg Deg)) - (///bundle.install "*" (binary Deg Deg Deg)) - (///bundle.install "/" (binary Deg Deg Deg)) - (///bundle.install "%" (binary Deg Deg Deg)) - (///bundle.install "=" (binary Deg Deg Bool)) - (///bundle.install "<" (binary Deg Deg Bool)) - (///bundle.install "scale" (binary Deg Nat Deg)) - (///bundle.install "reciprocal" (binary Deg Nat Deg)) - (///bundle.install "min" (nullary Deg)) - (///bundle.install "max" (nullary Deg)) - (///bundle.install "to-frac" (unary Deg Frac))))) - (def: bundle/frac ///.Bundle (<| (///bundle.prefix "frac") @@ -206,7 +189,7 @@ (///bundle.install "smallest" (nullary Frac)) (///bundle.install "min" (nullary Frac)) (///bundle.install "max" (nullary Frac)) - (///bundle.install "to-deg" (unary Frac Deg)) + (///bundle.install "to-rev" (unary Frac Rev)) (///bundle.install "to-int" (unary Frac Int)) (///bundle.install "encode" (unary Frac Text)) (///bundle.install "decode" (unary Text (type (Maybe Frac))))))) @@ -381,7 +364,6 @@ (dict.merge bundle/lux) (dict.merge bundle/bit) (dict.merge bundle/int) - (dict.merge bundle/deg) (dict.merge bundle/frac) (dict.merge bundle/text) (dict.merge bundle/array) diff --git a/stdlib/source/lux/lang/compiler/synthesis/case.lux b/stdlib/source/lux/lang/compiler/synthesis/case.lux index c12930963..88bfd36e9 100644 --- a/stdlib/source/lux/lang/compiler/synthesis/case.lux +++ b/stdlib/source/lux/lang/compiler/synthesis/case.lux @@ -30,7 +30,7 @@ ([#///analysis.Bool #//.Bool] [#///analysis.Nat (<| #//.I64 .i64)] [#///analysis.Int (<| #//.I64 .i64)] - [#///analysis.Deg (<| #//.I64 .i64)] + [#///analysis.Rev (<| #//.I64 .i64)] [#///analysis.Frac #//.F64] [#///analysis.Text #//.Text])) diff --git a/stdlib/source/lux/lang/compiler/synthesis/expression.lux b/stdlib/source/lux/lang/compiler/synthesis/expression.lux index 52ea33805..8a07b0aea 100644 --- a/stdlib/source/lux/lang/compiler/synthesis/expression.lux +++ b/stdlib/source/lux/lang/compiler/synthesis/expression.lux @@ -34,7 +34,7 @@ (<synthesis> (.i64 value))) ([#///analysis.Nat #//.I64] [#///analysis.Int #//.I64] - [#///analysis.Deg #//.I64]))) + [#///analysis.Rev #//.I64]))) (def: #export (synthesizer extensions) (-> (Extension ///extension.Synthesis) //.Synthesizer) diff --git a/stdlib/source/lux/lang/syntax.lux b/stdlib/source/lux/lang/syntax.lux index bbbd19232..536588443 100644 --- a/stdlib/source/lux/lang/syntax.lux +++ b/stdlib/source/lux/lang/syntax.lux @@ -25,7 +25,7 @@ ## (file-name, line, column) to keep track of their provenance and ## location, which is helpful for documentation and debugging. (.module: - [lux #- nat int deg] + [lux #- nat int rev] (lux (control monad ["p" parser "p/" Monad<Parser>] ["ex" exception #+ exception:]) @@ -222,10 +222,10 @@ rich-digits^) number.Codec<Text,Int>] - [deg #.Deg + [rev #.Rev (l.seq (l.one-of ".") rich-digits^) - number.Codec<Text,Deg>] + number.Codec<Text,Rev>] ) (def: (nat-char where) @@ -605,7 +605,7 @@ (nat where) (frac where) (int where) - (deg where) + (rev where) (symbol current-module aliases where) (tag current-module aliases where) (text where) diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux index 404d76b32..470406482 100644 --- a/stdlib/source/lux/macro.lux +++ b/stdlib/source/lux/macro.lux @@ -541,7 +541,7 @@ (wrap (:coerce Type def-value)))) (def: #export (definitions module-name) - {#.doc "The entire list of definitions in a module (including the unexported/private ones)."} + {#.doc "The entire list of definitions in a module (including the non-exported/private ones)."} (-> Text (Meta (List [Text Definition]))) (function (_ compiler) (case (get module-name (get@ #.modules compiler)) diff --git a/stdlib/source/lux/macro/code.lux b/stdlib/source/lux/macro/code.lux index f537eedac..67da53982 100644 --- a/stdlib/source/lux/macro/code.lux +++ b/stdlib/source/lux/macro/code.lux @@ -1,5 +1,5 @@ (.module: - [lux #- nat int deg] + [lux #- nat int rev] (lux (control [equality #+ Eq]) (data bool number @@ -36,7 +36,7 @@ [bool Bool #.Bool] [nat Nat #.Nat] [int Int #.Int] - [deg Deg #.Deg] + [rev Rev #.Rev] [frac Frac #.Frac] [text Text #.Text] [symbol Ident #.Symbol] @@ -65,7 +65,7 @@ ([#.Bool Eq<Bool>] [#.Nat Eq<Nat>] [#.Int Eq<Int>] - [#.Deg Eq<Deg>] + [#.Rev Eq<Rev>] [#.Frac Eq<Frac>] [#.Text Eq<Text>] [#.Symbol Eq<Ident>] @@ -101,7 +101,7 @@ ([#.Bool Codec<Text,Bool>] [#.Nat Codec<Text,Nat>] [#.Int Codec<Text,Int>] - [#.Deg Codec<Text,Deg>] + [#.Rev Codec<Text,Rev>] [#.Frac Codec<Text,Frac>] [#.Symbol Codec<Text,Ident>]) diff --git a/stdlib/source/lux/macro/poly/equality.lux b/stdlib/source/lux/macro/poly/equality.lux index c834509d8..6eb6ce4ce 100644 --- a/stdlib/source/lux/macro/poly/equality.lux +++ b/stdlib/source/lux/macro/poly/equality.lux @@ -49,7 +49,7 @@ [(poly.like Bool) bool.Eq<Bool>] [(poly.like Nat) number.Eq<Nat>] [(poly.like Int) number.Eq<Int>] - [(poly.like Deg) number.Eq<Deg>] + [(poly.like Rev) number.Eq<Rev>] [(poly.like Frac) number.Eq<Frac>] [(poly.like Text) text.Eq<Text>])) ## Composite types diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index c26cb7327..7e787ec95 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -1,5 +1,5 @@ (.module: - [lux #- nat int deg] + [lux #- nat int rev] (lux [macro #+ with-gensyms] (control [monad #+ do Monad] [equality #+ Eq] @@ -55,7 +55,7 @@ [ bool Bool #.Bool bool.Eq<Bool> "bool"] [ nat Nat #.Nat number.Eq<Nat> "nat"] [ int Int #.Int number.Eq<Int> "int"] - [ deg Deg #.Deg number.Eq<Deg> "deg"] + [ rev Rev #.Rev number.Eq<Rev> "rev"] [ frac Frac #.Frac number.Eq<Frac> "frac"] [ text Text #.Text text.Eq<Text> "text"] [symbol Ident #.Symbol ident.Eq<Ident> "symbol"] diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux index 5994a3c22..0ca31a34c 100644 --- a/stdlib/source/lux/math.lux +++ b/stdlib/source/lux/math.lux @@ -193,7 +193,7 @@ (p/map code.bool s.bool) (p/map code.nat s.nat) (p/map code.int s.int) - (p/map code.deg s.deg) + (p/map code.rev s.rev) (p/map code.frac s.frac) (p/map code.text s.text) (p/map code.symbol s.symbol) diff --git a/stdlib/source/lux/math/logic/continuous.lux b/stdlib/source/lux/math/logic/continuous.lux index 6e9de446a..9665f2561 100644 --- a/stdlib/source/lux/math/logic/continuous.lux +++ b/stdlib/source/lux/math/logic/continuous.lux @@ -1,39 +1,39 @@ (.module: lux - (lux (data [number "Deg/" Interval<Deg>]))) + (lux (data [number "Rev/" Interval<Rev>]))) -(def: #export ~true Deg Deg/top) -(def: #export ~false Deg Deg/bottom) +(def: #export ~true Rev Rev/top) +(def: #export ~false Rev Rev/bottom) (do-template [<name> <chooser>] [(def: #export <name> - (-> Deg Deg Deg) + (-> Rev Rev Rev) <chooser>)] - [~and d/min] - [~or d/max] + [~and r/min] + [~or r/max] ) (def: #export (~not input) - (-> Deg Deg) - (d/- input ~true)) + (-> Rev Rev) + (r/- input ~true)) (def: #export (~implies consequent antecedent) - (-> Deg Deg Deg) + (-> Rev Rev Rev) (~or (~not antecedent) consequent)) (def: #export (includes~ sub super) - (-> Deg Deg Deg) + (-> Rev Rev Rev) (let [-sub (~not sub) - sum (d/+ -sub super) - no-overflow? (and (d/>= -sub sum) - (d/>= super sum))] + sum (r/+ -sub super) + no-overflow? (and (r/>= -sub sum) + (r/>= super sum))] (if no-overflow? sum ~true))) (def: #export (~= left right) - (-> Deg Deg Deg) + (-> Rev Rev Rev) (~and (~or (~not left) right) (~or left (~not right)))) diff --git a/stdlib/source/lux/math/logic/fuzzy.lux b/stdlib/source/lux/math/logic/fuzzy.lux index 7c5ee4150..57f5978f3 100644 --- a/stdlib/source/lux/math/logic/fuzzy.lux +++ b/stdlib/source/lux/math/logic/fuzzy.lux @@ -1,6 +1,6 @@ (.module: lux - (lux (data [number "Deg/" Interval<Deg>] + (lux (data [number "Rev/" Interval<Rev>] (coll [list] (set ["set" unordered #+ Set])) text/format) @@ -8,10 +8,10 @@ (// ["&" continuous])) (type: #export (Fuzzy a) - (-> a Deg)) + (-> a Rev)) (def: #export (membership elem set) - (All [a] (-> a (Fuzzy a) Deg)) + (All [a] (-> a (Fuzzy a) Rev)) (set elem)) (def: #export (union left right) @@ -49,40 +49,40 @@ (from-predicate (set.member? set))) (def: (ascending from to) - (-> Deg Deg (Fuzzy Deg)) + (-> Rev Rev (Fuzzy Rev)) (function (_ elem) - (cond (d/<= from elem) + (cond (r/<= from elem) &.~false - (d/>= to elem) + (r/>= to elem) &.~true ## in the middle... - (d// (d/- from to) - (d/- from elem))))) + (r// (r/- from to) + (r/- from elem))))) (def: (descending from to) - (-> Deg Deg (Fuzzy Deg)) + (-> Rev Rev (Fuzzy Rev)) (function (_ elem) - (cond (d/<= from elem) + (cond (r/<= from elem) &.~true - (d/>= to elem) + (r/>= to elem) &.~false ## in the middle... - (d// (d/- from to) - (d/- elem to))))) + (r// (r/- from to) + (r/- elem to))))) (def: #export (gradient from to) - (-> Deg Deg (Fuzzy Deg)) - (if (d/< to from) + (-> Rev Rev (Fuzzy Rev)) + (if (r/< to from) (ascending from to) (descending from to))) (def: #export (triangle bottom middle top) - (-> Deg Deg Deg (Fuzzy Deg)) - (case (list.sort d/< (list bottom middle top)) + (-> Rev Rev Rev (Fuzzy Rev)) + (case (list.sort r/< (list bottom middle top)) (^ (list bottom middle top)) (intersection (ascending bottom middle) (descending middle top)) @@ -91,8 +91,8 @@ (undefined))) (def: #export (trapezoid bottom middle-bottom middle-top top) - (-> Deg Deg Deg Deg (Fuzzy Deg)) - (case (list.sort d/< (list bottom middle-bottom middle-top top)) + (-> Rev Rev Rev Rev (Fuzzy Rev)) + (case (list.sort r/< (list bottom middle-bottom middle-top top)) (^ (list bottom middle-bottom middle-top top)) (intersection (ascending bottom middle-bottom) (descending middle-top top)) @@ -101,26 +101,26 @@ (undefined))) (def: #export (cut treshold set) - (All [a] (-> Deg (Fuzzy a) (Fuzzy a))) + (All [a] (-> Rev (Fuzzy a) (Fuzzy a))) (function (_ elem) (let [membership (set elem)] - (if (d/> treshold membership) - (|> membership (d/- treshold) (d/* &.~true)) + (if (r/> treshold membership) + (|> membership (r/- treshold) (r/* &.~true)) &.~false)))) (def: #export (to-predicate treshold set) - (All [a] (-> Deg (Fuzzy a) (-> a Bool))) + (All [a] (-> Rev (Fuzzy a) (-> a Bool))) (function (_ elem) - (d/> treshold (set elem)))) + (r/> treshold (set elem)))) (type: #export (Fuzzy2 a) - (-> a [Deg Deg])) + (-> a [Rev Rev])) (def: #export (type-2 lower upper) (All [a] (-> (Fuzzy a) (Fuzzy a) (Fuzzy2 a))) (function (_ elem) - (let [l-deg (lower elem) - u-deg (upper elem)] - [(d/min l-deg - u-deg) - u-deg]))) + (let [l-rev (lower elem) + u-rev (upper elem)] + [(r/min l-rev + u-rev) + u-rev]))) diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux index 28751e125..5e560ea01 100644 --- a/stdlib/source/lux/math/random.lux +++ b/stdlib/source/lux/math/random.lux @@ -1,5 +1,5 @@ (.module: {#.doc "Pseudo-random number generation (PRNG) algorithms."} - [lux #- list i64 nat int deg char] + [lux #- list i64 nat int rev char] (lux (control [functor #+ Functor] [apply #+ Apply] [monad #+ do Monad] @@ -102,9 +102,9 @@ (Random Int) (:: Monad<Random> map .int ..i64)) -(def: #export deg - (Random Deg) - (:: Monad<Random> map .deg ..i64)) +(def: #export rev + (Random Rev) + (:: Monad<Random> map .rev ..i64)) (def: #export frac (Random Frac) |