diff options
Diffstat (limited to '')
| -rw-r--r-- | .github/workflows/test.yml | 2 | ||||
| -rw-r--r-- | changelog.md | 2 | ||||
| -rw-r--r-- | stdlib/source/library/lux/data/color.lux | 41 | ||||
| -rw-r--r-- | stdlib/source/library/lux/extension.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/library/lux/math.lux | 636 | ||||
| -rw-r--r-- | stdlib/source/library/lux/math/number/complex.lux | 111 | ||||
| -rw-r--r-- | stdlib/source/library/lux/math/number/frac.lux | 442 | ||||
| -rw-r--r-- | stdlib/source/library/lux/math/number/int.lux | 31 | ||||
| -rw-r--r-- | stdlib/source/library/lux/math/number/nat.lux | 10 | ||||
| -rw-r--r-- | stdlib/source/library/lux/math/number/rev.lux | 10 | ||||
| -rw-r--r-- | stdlib/source/library/lux/static.lux | 13 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/command/build.lux | 3 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/runtime.lux | 9 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/color.lux | 12 | ||||
| -rw-r--r-- | stdlib/source/test/lux/math.lux | 252 | ||||
| -rw-r--r-- | stdlib/source/test/lux/math/infix.lux | 33 | ||||
| -rw-r--r-- | stdlib/source/test/lux/math/number/complex.lux | 13 | ||||
| -rw-r--r-- | stdlib/source/test/lux/math/number/frac.lux | 145 |
18 files changed, 1051 insertions, 718 deletions
diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 23a031285..11861f6b0 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -6,7 +6,7 @@ jobs: steps: - uses: actions/checkout@v2 # Setup Aedifex - - run: wget https://github.com/LuxLang/lux/releases/download/0.6.5/aedifex_do_not_touch_1.jar && mv aedifex_do_not_touch_1.jar aedifex.jar + - run: wget https://github.com/LuxLang/lux/releases/download/0.6.5/aedifex_do_not_touch_2.jar && mv aedifex_do_not_touch_2.jar aedifex.jar - run: mv ./shell/lux.sh ./lux.sh # Test on the JVM # https://github.com/actions/setup-java diff --git a/changelog.md b/changelog.md index 5772001ac..df0d1be90 100644 --- a/changelog.md +++ b/changelog.md @@ -8,8 +8,10 @@ * Code selection based on compiler version. * Extensible meta-compiler. * Export machinery to consume Lux code from host-language programs. +* Generalized/type-agnostic arithmetic. ### Changed * JVM compilation no longer relies on the ASM library. +* Friendlier syntax. ### Removed ### Fixed ### Deprecated diff --git a/stdlib/source/library/lux/data/color.lux b/stdlib/source/library/lux/data/color.lux index e327ff261..093a2b6ba 100644 --- a/stdlib/source/library/lux/data/color.lux +++ b/stdlib/source/library/lux/data/color.lux @@ -1,25 +1,22 @@ (.using - [library - [lux "*" - [abstract - [equivalence {"+" Equivalence}] - [monoid {"+" Monoid}] - ["[0]" hash {"+" Hash}]] - [control - [parser - ["<[0]>" code]]] - [data - [collection - ["[0]" list ("[1]#[0]" functor)]]] - ["[0]" math - [number - ["n" nat] - ["f" frac] - ["[0]" int] - ["[0]" rev ("[1]#[0]" interval)] - ["[0]" i64]]] - [type - abstract]]]) + [library + [lux "*" + [abstract + [equivalence {"+" Equivalence}] + [monoid {"+" Monoid}] + ["[0]" hash {"+" Hash}]] + [data + [collection + ["[0]" list ("[1]#[0]" functor)]]] + [math + [number + ["n" nat] + ["f" frac] + ["[0]" int] + ["[0]" rev ("[1]#[0]" interval)] + ["[0]" i64]]] + [type + abstract]]]) (def: rgb_limit 256) (def: top (-- rgb_limit)) @@ -244,7 +241,7 @@ (def: .public (of_hsb [hue saturation brightness]) (-> HSB Color) (let [hue (|> hue (f.* +6.0)) - i (math.floor hue) + i (f.floor hue) f (|> hue (f.- i)) p (|> +1.0 (f.- saturation) (f.* brightness)) q (|> +1.0 (f.- (f.* f saturation)) (f.* brightness)) diff --git a/stdlib/source/library/lux/extension.lux b/stdlib/source/library/lux/extension.lux index cabab0a8f..2e2c74f23 100644 --- a/stdlib/source/library/lux/extension.lux +++ b/stdlib/source/library/lux/extension.lux @@ -13,8 +13,8 @@ [collection ["[0]" list ("[1]#[0]" functor)]]] [macro {"+" with_symbols} - ["[0]" code] - [syntax {"+" syntax:}]] + [syntax {"+" syntax:}] + ["[0]" code]] [tool [compiler ["[0]" phase]]]]]) diff --git a/stdlib/source/library/lux/math.lux b/stdlib/source/library/lux/math.lux index f9df0dd73..7395cb180 100644 --- a/stdlib/source/library/lux/math.lux +++ b/stdlib/source/library/lux/math.lux @@ -1,414 +1,228 @@ (.using [library [lux "*" - ["@" target] - [math - [number - ["n" nat] - ["i" int]]]]]) - -(template [<name> <value>] - [(def: .public <name> - <value>)] - - [e +2.7182818284590452354] - ... ["π is wrong!" by Bob Palais](https://www.math.utah.edu/~palais/pi.html) - [pi +3.14159265358979323846] - ... [The Tau Manifesto](https://tauday.com/tau-manifesto) - [tau +6.28318530717958647692] - ) - -(for @.old - (as_is (template [<name> <method>] - [(def: .public (<name> it) - (-> Frac Frac) - (<method> it))] - - [cos "jvm invokestatic:java.lang.Math:cos:double"] - [sin "jvm invokestatic:java.lang.Math:sin:double"] - [tan "jvm invokestatic:java.lang.Math:tan:double"] - - [acos "jvm invokestatic:java.lang.Math:acos:double"] - [asin "jvm invokestatic:java.lang.Math:asin:double"] - [atan "jvm invokestatic:java.lang.Math:atan:double"] - - [exp "jvm invokestatic:java.lang.Math:exp:double"] - [log "jvm invokestatic:java.lang.Math:log:double"] - - [ceil "jvm invokestatic:java.lang.Math:ceil:double"] - [floor "jvm invokestatic:java.lang.Math:floor:double"] - - [root/2 "jvm invokestatic:java.lang.Math:sqrt:double"] - [root/3 "jvm invokestatic:java.lang.Math:cbrt:double"] - ) - (def: .public (pow param subject) - (-> Frac Frac Frac) - ("jvm invokestatic:java.lang.Math:pow:double,double" subject param))) - - @.jvm - (as_is (template: (!double value) - [(|> value - (:as (Primitive "java.lang.Double")) - "jvm object cast")]) - - (template: (!frac value) - [(|> value - "jvm object cast" - (: (Primitive "java.lang.Double")) - (:as Frac))]) - - (template [<name> <method>] - [(def: .public <name> - (-> Frac Frac) - (|>> !double - ["D"] - ("jvm member invoke static" [] "java.lang.Math" <method> []) - !frac))] - - [cos "cos"] - [sin "sin"] - [tan "tan"] - - [acos "acos"] - [asin "asin"] - [atan "atan"] - - [exp "exp"] - [log "log"] - - [ceil "ceil"] - [floor "floor"] - - [root/2 "sqrt"] - [root/3 "cbrt"] - ) - - (def: .public (pow param subject) - (-> Frac Frac Frac) - (|> ("jvm member invoke static" [] "java.lang.Math" "pow" [] - ["D" (!double subject)] ["D" (!double param)]) - !frac))) - - @.js - (as_is (template [<name> <method>] - [(def: .public <name> - (-> Frac Frac) - (|>> [] - ("js apply" ("js constant" <method>)) - (:as Frac)))] - - [cos "Math.cos"] - [sin "Math.sin"] - [tan "Math.tan"] - - [acos "Math.acos"] - [asin "Math.asin"] - [atan "Math.atan"] - - [exp "Math.exp"] - [log "Math.log"] - - [ceil "Math.ceil"] - [floor "Math.floor"] - - [root/2 "Math.sqrt"] - [root/3 "Math.cbrt"] - ) - - (def: .public (pow param subject) - (-> Frac Frac Frac) - (:as Frac ("js apply" ("js constant" "Math.pow") [subject param])))) - - @.python - (as_is (template [<name> <method>] - [(def: .public <name> - (-> Frac Frac) - (|>> [] - ("python object do" <method> ("python import" "math")) - (:as Frac)))] - - [cos "cos"] - [sin "sin"] - [tan "tan"] - - [acos "acos"] - [asin "asin"] - [atan "atan"] - - [exp "exp"] - [log "log"] - - [ceil "ceil"] - [floor "floor"] - - [root/2 "sqrt"] - ) - - (def: .public (pow param subject) - (-> Frac Frac Frac) - (:as Frac ("python object do" "pow" ("python import" "math") [subject param]))) - - (def: .public (root/3 it) - (-> Frac Frac) - (if ("lux f64 <" +0.0 it) - (|> it - ("lux f64 *" -1.0) - (..pow ("lux f64 /" +3.0 +1.0)) - ("lux f64 *" -1.0)) - (|> it - (..pow ("lux f64 /" +3.0 +1.0)))))) - - @.lua - (as_is (template [<name> <method>] - [(def: .public <name> - (-> Frac Frac) - (|>> [] - ("lua apply" ("lua constant" <method>)) - (:as Frac)))] - - [cos "math.cos"] - [sin "math.sin"] - [tan "math.tan"] - - [acos "math.acos"] - [asin "math.asin"] - [atan "math.atan"] - - [exp "math.exp"] - [log "math.log"] - - [ceil "math.ceil"] - [floor "math.floor"] - - [root/2 "math.sqrt"] - ) - - (def: .public (pow param subject) - (-> Frac Frac Frac) - ("lua power" param subject)) - - (def: .public (root/3 it) - (-> Frac Frac) - (if ("lux f64 <" +0.0 it) - (|> it - ("lux f64 *" -1.0) - (..pow ("lux f64 /" +3.0 +1.0)) - ("lux f64 *" -1.0)) - (|> it - (..pow ("lux f64 /" +3.0 +1.0)))))) - - @.ruby - (as_is (template [<name> <method>] - [(def: .public <name> - (-> Frac Frac) - (|>> [] - ("ruby apply" ("ruby constant" <method>)) - (:as Frac)))] - - [cos "Math.cos"] - [sin "Math.sin"] - [tan "Math.tan"] - - [acos "Math.acos"] - [asin "Math.asin"] - [atan "Math.atan"] - - [exp "Math.exp"] - [log "Math.log"] - - [root/2 "Math.sqrt"] - [root/3 "Math.cbrt"] - ) - - (template [<name> <method>] - [(def: .public (<name> it) - (-> Frac Frac) - (|> ("ruby object do" <method> it []) - (:as Int) - ("lux i64 f64")))] - - [ceil "ceil"] - [floor "floor"] - ) - - (def: .public (pow param subject) - (-> Frac Frac Frac) - (:as Frac ("ruby object do" "**" subject [param])))) - - @.php - (as_is (template [<name> <method>] - [(def: .public <name> - (-> Frac Frac) - (|>> ("php apply" ("php constant" <method>)) - (:as Frac)))] - - [cos "cos"] - [sin "sin"] - [tan "tan"] - - [acos "acos"] - [asin "asin"] - [atan "atan"] - - [exp "exp"] - [log "log"] - - [ceil "ceil"] - [floor "floor"] - - [root/2 "sqrt"] - ) - - (def: .public (pow param subject) - (-> Frac Frac Frac) - (:as Frac ("php apply" ("php constant" "pow") subject param))) - - (def: .public root/3 - (-> Frac Frac) - (..pow ("lux f64 /" +3.0 +1.0)))) - - @.scheme - (as_is (template [<name> <method>] - [(def: .public <name> - (-> Frac Frac) - (|>> ("scheme apply" ("scheme constant" <method>)) - (:as Frac)))] - - [cos "cos"] - [sin "sin"] - [tan "tan"] - - [acos "acos"] - [asin "asin"] - [atan "atan"] - - [exp "exp"] - [log "log"] - - [ceil "ceiling"] - [floor "floor"] - - [root/2 "sqrt"] - ) - - (def: .public (pow param subject) - (-> Frac Frac Frac) - (:as Frac ("scheme apply" ("scheme constant" "expt") subject param))) - - (def: .public root/3 - (-> Frac Frac) - (..pow ("lux f64 /" +3.0 +1.0)))) - ) - -(def: .public (round it) - (-> Frac Frac) - (let [floored (floor it) - diff ("lux f64 -" floored it)] - (cond ("lux f64 <" diff +0.5) - ("lux f64 +" +1.0 floored) - - ("lux f64 <" -0.5 diff) - ("lux f64 +" -1.0 floored) - - ... else - floored))) - -(def: .public (atan/2 x y) - (-> Frac Frac Frac) - (cond ("lux f64 <" x +0.0) - (..atan ("lux f64 /" x y)) - - ("lux f64 <" +0.0 x) - (if (or ("lux f64 <" y +0.0) - ("lux f64 =" +0.0 y)) - (|> y ("lux f64 /" x) atan ("lux f64 +" pi)) - (|> y ("lux f64 /" x) atan ("lux f64 -" pi))) - - ... ("lux f64 =" +0.0 x) - (cond ("lux f64 <" y +0.0) - (|> pi ("lux f64 /" +2.0)) - - ("lux f64 <" +0.0 y) - (|> pi ("lux f64 /" -2.0)) - - ... ("lux f64 =" +0.0 y) - ("lux f64 /" +0.0 +0.0)))) - -(def: .public (log_by base it) - (-> Frac Frac Frac) - ("lux f64 /" - (..log base) - (..log it))) - -(def: .public (factorial it) - (-> Nat Nat) - (loop [acc 1 - it it] - (if (n.> 1 it) - (again (n.* it acc) (-- it)) - acc))) - -(def: .public (hypotenuse catA catB) - (-> Frac Frac Frac) - (..pow +0.5 ("lux f64 +" - (..pow +2.0 catA) - (..pow +2.0 catB)))) - -... Hyperbolic functions -... https://en.wikipedia.org/wiki/Hyperbolic_function#Definitions -(template [<name> <comp> <inverse>] - [(def: .public (<name> it) - (-> Frac Frac) - (|> (..exp it) (<comp> (..exp ("lux f64 *" -1.0 it))) ("lux f64 /" +2.0))) - - (def: .public (<inverse> it) - (-> Frac Frac) - (|> +2.0 ("lux f64 /" (|> (..exp it) (<comp> (..exp ("lux f64 *" -1.0 it)))))))] - - [sinh "lux f64 -" csch] - [cosh "lux f64 +" sech] - ) - -(template [<name> <top> <bottom>] - [(def: .public (<name> it) - (-> Frac Frac) - (let [e+ (exp it) - e- (exp ("lux f64 *" -1.0 it)) - sinh' (|> e+ ("lux f64 -" e-)) - cosh' (|> e+ ("lux f64 +" e-))] - (|> <top> ("lux f64 /" <bottom>))))] - - [tanh sinh' cosh'] - [coth cosh' sinh'] - ) - -... https://en.wikipedia.org/wiki/Inverse_hyperbolic_functions#Definitions_in_terms_of_logarithms -(template [<name> <comp>] - [(def: .public (<name> it) - (-> Frac Frac) - (|> it (pow +2.0) (<comp> +1.0) (pow +0.5) ("lux f64 +" it) log))] - - [asinh "lux f64 +"] - [acosh "lux f64 -"] - ) - -(template [<name> <base> <diff>] - [(def: .public (<name> it) - (-> Frac Frac) - (let [it+ (|> <base> ("lux f64 +" <diff>)) - it- (|> <base> ("lux f64 -" <diff>))] - (|> it+ ("lux f64 /" it-) log ("lux f64 /" +2.0))))] - - [atanh +1.0 it] - [acoth it +1.0] - ) - -(template [<name> <op>] - [(def: .public (<name> it) - (-> Frac Frac) - (let [it^2 (|> it (pow +2.0))] - (|> +1.0 (<op> it^2) (pow +0.5) ("lux f64 +" +1.0) ("lux f64 /" it) log)))] - - [asech "lux f64 -"] - [acsch "lux f64 +"] - ) + [extension {"+" analysis:}] + ["[0]" static] + [abstract + ["[0]" monad {"+" do}]] + [control + ["[0]" try {"+" Try}] + ["[0]" exception {"+" exception:}] + ["<>" parser + ["<[0]>" code]]] + [data + [text + ["%" format]] + [collection + ["[0]" list ("[1]#[0]" mix)]]] + [macro + [syntax {"+" syntax:}] + ["[0]" template]] + [tool + [compiler + ["[0]" phase ("[1]#[0]" monad)] + [language + [lux + ["[0]" analysis {"+" Analysis Operation Phase} + ["[0]" type]]]] + [meta + [archive {"+" Archive}]]]] + [type + ["[0]" check]]]] + [/ + ["[0]" random] + [number + ["[0]" nat] + ["[0]" int] + ["[0]" rev] + ["[0]" frac] + ["[0]" ratio {"+" Ratio}] + ["[0]" complex {"+" Complex}]]]) + +(exception: (no_arithmetic_for [type Type]) + (exception.report + "Type" (%.type type))) + +(def: (composite phase archive <+> last prevs) + (-> Phase Archive Code Analysis (List Analysis) (Operation Analysis)) + (case <+> + [_ {.#Text $}] + (phase#in (list#mix (function (_ left right) + {analysis.#Extension $ (list left right)}) + last + prevs)) + + _ + (do phase.monad + [[_ $] (type.inferring + (phase archive <+>))] + (in (list#mix (function (_ left right) + (analysis.reified [$ (list left right)])) + last + prevs))))) + +(with_expansions [<@> (static.text (let [[@ _] (symbol .._)] @)) + <ratio/0> [ratio.#numerator 0 ratio.#denominator 1] + <ratio/1> [ratio.#numerator 1 ratio.#denominator 1] + <complex/0> [complex.#real +0.0 complex.#imaginary +0.0] + <complex/1> [complex.#real +1.0 complex.#imaginary +0.0]] + (as_is (template [<name> <scenarios>'] + [(with_expansions [<extension> (static.seed) + <extension> (template.text [<@> " " <extension>]) + <scenarios> (template.spliced <scenarios>')] + (as_is (analysis: (<extension> self phase archive [operands (<>.some <code>.any)]) + (<| type.with_var + (function (_ [$it :it:])) + (do [! phase.monad] + [operands (monad.each ! (|>> (phase archive) (type.expecting :it:)) + operands) + _ (type.inference :it:) + :it: (type.check (check.identity (list) $it))] + (case (list.reversed operands) + (pattern (list single)) + (in single) + + (pattern (list)) + (`` (cond (check.subsumes? .I64 :it:) + (phase.except ..no_arithmetic_for [:it:]) + + (~~ (template [<type> <0> <+>] + [(check.subsumes? <type> :it:) + <0>] + + <scenarios>)) + + ... else + (phase.except ..no_arithmetic_for [:it:]))) + + (pattern (list& last prevs)) + (`` (cond (check.subsumes? .I64 :it:) + (phase.except ..no_arithmetic_for [:it:]) + + (~~ (template [<type> <0> <+>] + [(check.subsumes? <type> :it:) + (..composite phase archive (` <+>) last prevs)] + + <scenarios>)) + + ... else + (phase.except ..no_arithmetic_for [:it:]))))))) + (syntax: .public (<name> [operands (<>.some <code>.any)]) + (in (list (` (<extension> (~+ operands))))))))] + + [+ [[.Nat (in (analysis.nat 0)) "lux i64 +"] + [.Int (in (analysis.int +0)) "lux i64 +"] + [.Rev (in (analysis.rev .0)) "lux i64 +"] + [.Frac (in (analysis.frac +0.0)) "lux f64 +"] + [Ratio (type.expecting Ratio (phase archive (` <ratio/0>))) ratio.+] + [Complex (type.expecting Complex (phase archive (` <complex/0>))) complex.+]]] + [- [[.Nat (in (analysis.nat 0)) "lux i64 -"] + [.Int (in (analysis.int -0)) "lux i64 -"] + [.Rev (in (analysis.rev .0)) "lux i64 -"] + [.Frac (in (analysis.frac -0.0)) "lux f64 -"] + [Ratio (type.expecting Ratio (phase archive (` <ratio/0>))) ratio.-] + [Complex (type.expecting Complex (phase archive (` <complex/0>))) complex.-]]] + [* [[.Nat (in (analysis.nat 1)) nat.*] + [.Int (in (analysis.int +1)) "lux i64 *"] + [.Rev (in (analysis.rev rev./1)) rev.*] + [.Frac (in (analysis.frac +1.0)) "lux f64 *"] + [Ratio (type.expecting Ratio (phase archive (` <ratio/1>))) ratio.*] + [Complex (type.expecting Complex (phase archive (` <complex/1>))) complex.*]]] + [/ [[.Nat (in (analysis.nat 1)) nat./] + [.Int (in (analysis.int +1)) "lux i64 /"] + [.Rev (in (analysis.rev rev./1)) rev./] + [.Frac (in (analysis.frac +1.0)) "lux f64 /"] + [Ratio (type.expecting Ratio (phase archive (` <ratio/1>))) ratio./] + [Complex (type.expecting Complex (phase archive (` <complex/1>))) complex./]]] + ) + (template [<name> <scenarios>'] + [(with_expansions [<extension> (static.seed) + <extension> (template.text [<@> " " <extension>]) + <scenarios> (template.spliced <scenarios>')] + (as_is (analysis: (<extension> self phase archive [left <code>.any + right <code>.any]) + (<| type.with_var + (function (_ [$it :it:])) + (do [! phase.monad] + [left (type.expecting :it: (phase archive left)) + right (type.expecting :it: (phase archive right)) + _ (type.inference .Bit) + :it: (type.check (check.identity (list) $it))] + (`` (cond (check.subsumes? .I64 :it:) + (phase.except ..no_arithmetic_for [:it:]) + + (~~ (template [<type> <+>] + [(check.subsumes? <type> :it:) + (..composite phase archive (` <+>) right (list left))] + + <scenarios>)) + + ... else + (phase.except ..no_arithmetic_for [:it:])))))) + (syntax: .public (<name> [left <code>.any + right <code>.any]) + (in (list (` (<extension> (~ left) (~ right))))))))] + + [= [[.Nat "lux i64 ="] + [.Int "lux i64 ="] + [.Rev "lux i64 ="] + [.Frac "lux f64 ="] + [Ratio ratio.=] + [Complex complex.=]]] + [< [[.Nat nat.<] + [.Int "lux i64 <"] + [.Rev rev.<] + [.Frac "lux f64 <"] + [Ratio ratio.<]]] + [> [[.Nat nat.>] + [.Int int.>] + [.Rev rev.>] + [.Frac frac.>] + [Ratio ratio.>]]] + [<= [[.Nat nat.<=] + [.Int int.<=] + [.Rev rev.<=] + [.Frac frac.<=] + [Ratio ratio.<=]]] + [>= [[.Nat nat.>=] + [.Int int.>=] + [.Rev rev.>=] + [.Frac frac.>=] + [Ratio ratio.>=]]] + ) + (template [<name> <scenarios>'] + [(with_expansions [<extension> (static.seed) + <extension> (template.text [<@> " " <extension>]) + <scenarios> (template.spliced <scenarios>')] + (as_is (analysis: (<extension> self phase archive [left <code>.any + right <code>.any]) + (<| type.with_var + (function (_ [$it :it:])) + (do [! phase.monad] + [left (type.expecting :it: (phase archive left)) + right (type.expecting :it: (phase archive right)) + _ (type.inference :it:) + :it: (type.check (check.identity (list) $it))] + (`` (cond (check.subsumes? .I64 :it:) + (phase.except ..no_arithmetic_for [:it:]) + + (~~ (template [<type> <+>] + [(check.subsumes? <type> :it:) + (..composite phase archive (` <+>) right (list left))] + + <scenarios>)) + + ... else + (phase.except ..no_arithmetic_for [:it:])))))) + (syntax: .public (<name> [left <code>.any + right <code>.any]) + (in (list (` (<extension> (~ left) (~ right))))))))] + + [% [[.Nat nat.%] + [.Int "lux i64 %"] + [.Rev rev.%] + [.Frac "lux f64 %"] + [Ratio ratio.%] + [Complex complex.%]]] + ) + )) diff --git a/stdlib/source/library/lux/math/number/complex.lux b/stdlib/source/library/lux/math/number/complex.lux index 52947b51b..470a9bfbf 100644 --- a/stdlib/source/library/lux/math/number/complex.lux +++ b/stdlib/source/library/lux/math/number/complex.lux @@ -1,24 +1,19 @@ (.using [library [lux "*" - ["[0]" math] [abstract - [equivalence {"+" Equivalence}] - [codec {"+" Codec}] - ["M" monad {"+" Monad do}]] + [equivalence {"+" Equivalence}]] [control ["[0]" maybe] ["<>" parser - ["<[0]>" code {"+" Parser}]]] + ["<[0]>" code]]] [data [collection ["[0]" list ("[1]#[0]" functor)]]] [macro - [syntax {"+" syntax:}] - ["[0]" code]] + [syntax {"+" syntax:}]] [math [number - ["n" nat] ["f" frac] ["[0]" int]]]]]) @@ -133,60 +128,60 @@ (-> Complex Complex Complex) (let [scaled (/ param input) quotient (|> scaled - (revised #real math.floor) - (revised #imaginary math.floor))] + (revised #real f.floor) + (revised #imaginary f.floor))] (- (* quotient param) input))) (def: .public (cos subject) (-> Complex Complex) (let [(open "[0]") subject] - [..#real (f.* (math.cosh #imaginary) - (math.cos #real)) - ..#imaginary (f.opposite (f.* (math.sinh #imaginary) - (math.sin #real)))])) + [..#real (f.* (f.cosh #imaginary) + (f.cos #real)) + ..#imaginary (f.opposite (f.* (f.sinh #imaginary) + (f.sin #real)))])) (def: .public (cosh subject) (-> Complex Complex) (let [(open "[0]") subject] - [..#real (f.* (math.cos #imaginary) - (math.cosh #real)) - ..#imaginary (f.* (math.sin #imaginary) - (math.sinh #real))])) + [..#real (f.* (f.cos #imaginary) + (f.cosh #real)) + ..#imaginary (f.* (f.sin #imaginary) + (f.sinh #real))])) (def: .public (sin subject) (-> Complex Complex) (let [(open "[0]") subject] - [..#real (f.* (math.cosh #imaginary) - (math.sin #real)) - ..#imaginary (f.* (math.sinh #imaginary) - (math.cos #real))])) + [..#real (f.* (f.cosh #imaginary) + (f.sin #real)) + ..#imaginary (f.* (f.sinh #imaginary) + (f.cos #real))])) (def: .public (sinh subject) (-> Complex Complex) (let [(open "[0]") subject] - [..#real (f.* (math.cos #imaginary) - (math.sinh #real)) - ..#imaginary (f.* (math.sin #imaginary) - (math.cosh #real))])) + [..#real (f.* (f.cos #imaginary) + (f.sinh #real)) + ..#imaginary (f.* (f.sin #imaginary) + (f.cosh #real))])) (def: .public (tan subject) (-> Complex Complex) (let [(open "[0]") subject r2 (f.* +2.0 #real) i2 (f.* +2.0 #imaginary) - d (f.+ (math.cos r2) (math.cosh i2))] - [..#real (f./ d (math.sin r2)) - ..#imaginary (f./ d (math.sinh i2))])) + d (f.+ (f.cos r2) (f.cosh i2))] + [..#real (f./ d (f.sin r2)) + ..#imaginary (f./ d (f.sinh i2))])) (def: .public (tanh subject) (-> Complex Complex) (let [(open "[0]") subject r2 (f.* +2.0 #real) i2 (f.* +2.0 #imaginary) - d (f.+ (math.cosh r2) (math.cos i2))] - [..#real (f./ d (math.sinh r2)) - ..#imaginary (f./ d (math.sin i2))])) + d (f.+ (f.cosh r2) (f.cos i2))] + [..#real (f./ d (f.sinh r2)) + ..#imaginary (f./ d (f.sin i2))])) (def: .public (abs subject) (-> Complex Frac) @@ -196,26 +191,26 @@ (if (f.= +0.0 #imaginary) (f.abs #real) (let [q (f./ #imaginary #real)] - (f.* (math.pow +0.5 (f.+ +1.0 (f.* q q))) + (f.* (f.pow +0.5 (f.+ +1.0 (f.* q q))) (f.abs #imaginary)))) (if (f.= +0.0 #real) (f.abs #imaginary) (let [q (f./ #real #imaginary)] - (f.* (math.pow +0.5 (f.+ +1.0 (f.* q q))) + (f.* (f.pow +0.5 (f.+ +1.0 (f.* q q))) (f.abs #real))))))) (def: .public (exp subject) (-> Complex Complex) (let [(open "[0]") subject - r_exp (math.exp #real)] - [..#real (f.* r_exp (math.cos #imaginary)) - ..#imaginary (f.* r_exp (math.sin #imaginary))])) + r_exp (f.exp #real)] + [..#real (f.* r_exp (f.cos #imaginary)) + ..#imaginary (f.* r_exp (f.sin #imaginary))])) (def: .public (log subject) (-> Complex Complex) (let [(open "[0]") subject] - [..#real (|> subject ..abs math.log) - ..#imaginary (math.atan/2 #real #imaginary)])) + [..#real (|> subject ..abs f.log) + ..#imaginary (f.atan/2 #real #imaginary)])) (template [<name> <type> <op>] [(def: .public (<name> param input) @@ -233,7 +228,7 @@ (def: .public (root/2 input) (-> Complex Complex) (let [(open "[0]") input - t (|> input ..abs (f.+ (f.abs #real)) (f./ +2.0) (math.pow +0.5))] + t (|> input ..abs (f.+ (f.abs #real)) (f./ +2.0) (f.pow +0.5))] (if (f.< +0.0 #real) [..#real (f./ (f.* +2.0 t) (f.abs #imaginary)) @@ -286,27 +281,27 @@ (def: .public (argument (open "[0]")) (-> Complex Frac) - (math.atan/2 #real #imaginary)) + (f.atan/2 #real #imaginary)) (def: .public (roots nth input) (-> Nat Complex (List Complex)) - (if (n.= 0 nth) - (list) - (let [r_nth (|> nth .int int.frac) - nth_root_of_abs (|> input ..abs (math.pow (f./ r_nth +1.0))) - nth_phi (|> input ..argument (f./ r_nth)) - slice (|> math.pi (f.* +2.0) (f./ r_nth))] - (|> (list.indices nth) - (list#each (function (_ nth') - (let [inner (|> nth' .int int.frac - (f.* slice) - (f.+ nth_phi)) - real (f.* nth_root_of_abs - (math.cos inner)) - imaginary (f.* nth_root_of_abs - (math.sin inner))] - [..#real real - ..#imaginary imaginary]))))))) + (case nth + 0 (list) + _ (let [r_nth (|> nth .int int.frac) + nth_root_of_abs (|> input ..abs (f.pow (f./ r_nth +1.0))) + nth_phi (|> input ..argument (f./ r_nth)) + slice (|> f.pi (f.* +2.0) (f./ r_nth))] + (|> (list.indices nth) + (list#each (function (_ nth') + (let [inner (|> nth' .int int.frac + (f.* slice) + (f.+ nth_phi)) + real (f.* nth_root_of_abs + (f.cos inner)) + imaginary (f.* nth_root_of_abs + (f.sin inner))] + [..#real real + ..#imaginary imaginary]))))))) (def: .public (approximately? margin_of_error standard value) (-> Frac Complex Complex Bit) diff --git a/stdlib/source/library/lux/math/number/frac.lux b/stdlib/source/library/lux/math/number/frac.lux index d3cd5f138..511b0fef9 100644 --- a/stdlib/source/library/lux/math/number/frac.lux +++ b/stdlib/source/library/lux/math/number/frac.lux @@ -21,16 +21,422 @@ ["[1][0]" i64] ["[1][0]" nat] ["[1][0]" int] - ["[1][0]" rev] - ["/[1]" //]]) + ["[1][0]" rev]]) -(def: .public (= reference sample) - (-> Frac Frac Bit) - ("lux f64 =" reference sample)) +(template [<name> <value>] + [(def: .public <name> + <value>)] -(def: .public (< reference sample) - (-> Frac Frac Bit) - ("lux f64 <" reference sample)) + [e +2.7182818284590452354] + ... ["π is wrong!" by Bob Palais](https://www.math.utah.edu/~palais/pi.html) + [pi +3.14159265358979323846] + ... [The Tau Manifesto](https://tauday.com/tau-manifesto) + [tau +6.28318530717958647692] + ) + +(for @.old + (as_is (template [<name> <method>] + [(def: .public (<name> it) + (-> Frac Frac) + (<method> it))] + + [cos "jvm invokestatic:java.lang.Math:cos:double"] + [sin "jvm invokestatic:java.lang.Math:sin:double"] + [tan "jvm invokestatic:java.lang.Math:tan:double"] + + [acos "jvm invokestatic:java.lang.Math:acos:double"] + [asin "jvm invokestatic:java.lang.Math:asin:double"] + [atan "jvm invokestatic:java.lang.Math:atan:double"] + + [exp "jvm invokestatic:java.lang.Math:exp:double"] + [log "jvm invokestatic:java.lang.Math:log:double"] + + [ceil "jvm invokestatic:java.lang.Math:ceil:double"] + [floor "jvm invokestatic:java.lang.Math:floor:double"] + + [root/2 "jvm invokestatic:java.lang.Math:sqrt:double"] + [root/3 "jvm invokestatic:java.lang.Math:cbrt:double"] + ) + (def: .public (pow param subject) + (-> Frac Frac Frac) + ("jvm invokestatic:java.lang.Math:pow:double,double" subject param))) + + @.jvm + (as_is (template: (!double value) + [(|> value + (:as (Primitive "java.lang.Double")) + "jvm object cast")]) + + (template: (!frac value) + [(|> value + "jvm object cast" + (: (Primitive "java.lang.Double")) + (:as Frac))]) + + (template [<name> <method>] + [(def: .public <name> + (-> Frac Frac) + (|>> !double + ["D"] + ("jvm member invoke static" [] "java.lang.Math" <method> []) + !frac))] + + [cos "cos"] + [sin "sin"] + [tan "tan"] + + [acos "acos"] + [asin "asin"] + [atan "atan"] + + [exp "exp"] + [log "log"] + + [ceil "ceil"] + [floor "floor"] + + [root/2 "sqrt"] + [root/3 "cbrt"] + ) + + (def: .public (pow param subject) + (-> Frac Frac Frac) + (|> ("jvm member invoke static" [] "java.lang.Math" "pow" [] + ["D" (!double subject)] ["D" (!double param)]) + !frac))) + + @.js + (as_is (template [<name> <method>] + [(def: .public <name> + (-> Frac Frac) + (|>> [] + ("js apply" ("js constant" <method>)) + (:as Frac)))] + + [cos "Math.cos"] + [sin "Math.sin"] + [tan "Math.tan"] + + [acos "Math.acos"] + [asin "Math.asin"] + [atan "Math.atan"] + + [exp "Math.exp"] + [log "Math.log"] + + [ceil "Math.ceil"] + [floor "Math.floor"] + + [root/2 "Math.sqrt"] + [root/3 "Math.cbrt"] + ) + + (def: .public (pow param subject) + (-> Frac Frac Frac) + (:as Frac ("js apply" ("js constant" "Math.pow") [subject param])))) + + @.python + (as_is (template [<name> <method>] + [(def: .public <name> + (-> Frac Frac) + (|>> [] + ("python object do" <method> ("python import" "math")) + (:as Frac)))] + + [cos "cos"] + [sin "sin"] + [tan "tan"] + + [acos "acos"] + [asin "asin"] + [atan "atan"] + + [exp "exp"] + [log "log"] + + [ceil "ceil"] + [floor "floor"] + + [root/2 "sqrt"] + ) + + (def: .public (pow param subject) + (-> Frac Frac Frac) + (:as Frac ("python object do" "pow" ("python import" "math") [subject param]))) + + (def: .public (root/3 it) + (-> Frac Frac) + (if ("lux f64 <" +0.0 it) + (|> it + ("lux f64 *" -1.0) + (..pow ("lux f64 /" +3.0 +1.0)) + ("lux f64 *" -1.0)) + (|> it + (..pow ("lux f64 /" +3.0 +1.0)))))) + + @.lua + (as_is (template [<name> <method>] + [(def: .public <name> + (-> Frac Frac) + (|>> [] + ("lua apply" ("lua constant" <method>)) + (:as Frac)))] + + [cos "math.cos"] + [sin "math.sin"] + [tan "math.tan"] + + [acos "math.acos"] + [asin "math.asin"] + [atan "math.atan"] + + [exp "math.exp"] + [log "math.log"] + + [ceil "math.ceil"] + [floor "math.floor"] + + [root/2 "math.sqrt"] + ) + + (def: .public (pow param subject) + (-> Frac Frac Frac) + ("lua power" param subject)) + + (def: .public (root/3 it) + (-> Frac Frac) + (if ("lux f64 <" +0.0 it) + (|> it + ("lux f64 *" -1.0) + (..pow ("lux f64 /" +3.0 +1.0)) + ("lux f64 *" -1.0)) + (|> it + (..pow ("lux f64 /" +3.0 +1.0)))))) + + @.ruby + (as_is (template [<name> <method>] + [(def: .public <name> + (-> Frac Frac) + (|>> [] + ("ruby apply" ("ruby constant" <method>)) + (:as Frac)))] + + [cos "Math.cos"] + [sin "Math.sin"] + [tan "Math.tan"] + + [acos "Math.acos"] + [asin "Math.asin"] + [atan "Math.atan"] + + [exp "Math.exp"] + [log "Math.log"] + + [root/2 "Math.sqrt"] + [root/3 "Math.cbrt"] + ) + + (template [<name> <method>] + [(def: .public (<name> it) + (-> Frac Frac) + (|> ("ruby object do" <method> it []) + (:as Int) + ("lux i64 f64")))] + + [ceil "ceil"] + [floor "floor"] + ) + + (def: .public (pow param subject) + (-> Frac Frac Frac) + (:as Frac ("ruby object do" "**" subject [param])))) + + @.php + (as_is (template [<name> <method>] + [(def: .public <name> + (-> Frac Frac) + (|>> ("php apply" ("php constant" <method>)) + (:as Frac)))] + + [cos "cos"] + [sin "sin"] + [tan "tan"] + + [acos "acos"] + [asin "asin"] + [atan "atan"] + + [exp "exp"] + [log "log"] + + [ceil "ceil"] + [floor "floor"] + + [root/2 "sqrt"] + ) + + (def: .public (pow param subject) + (-> Frac Frac Frac) + (:as Frac ("php apply" ("php constant" "pow") subject param))) + + (def: .public root/3 + (-> Frac Frac) + (..pow ("lux f64 /" +3.0 +1.0)))) + + @.scheme + (as_is (template [<name> <method>] + [(def: .public <name> + (-> Frac Frac) + (|>> ("scheme apply" ("scheme constant" <method>)) + (:as Frac)))] + + [cos "cos"] + [sin "sin"] + [tan "tan"] + + [acos "acos"] + [asin "asin"] + [atan "atan"] + + [exp "exp"] + [log "log"] + + [ceil "ceiling"] + [floor "floor"] + + [root/2 "sqrt"] + ) + + (def: .public (pow param subject) + (-> Frac Frac Frac) + (:as Frac ("scheme apply" ("scheme constant" "expt") subject param))) + + (def: .public root/3 + (-> Frac Frac) + (..pow ("lux f64 /" +3.0 +1.0)))) + ) + +(def: .public (round it) + (-> Frac Frac) + (let [floored (floor it) + diff ("lux f64 -" floored it)] + (cond ("lux f64 <" diff +0.5) + ("lux f64 +" +1.0 floored) + + ("lux f64 <" -0.5 diff) + ("lux f64 +" -1.0 floored) + + ... else + floored))) + +(def: .public (atan/2 x y) + (-> Frac Frac Frac) + (cond ("lux f64 <" x +0.0) + (..atan ("lux f64 /" x y)) + + ("lux f64 <" +0.0 x) + (if (or ("lux f64 <" y +0.0) + ("lux f64 =" +0.0 y)) + (|> y ("lux f64 /" x) atan ("lux f64 +" pi)) + (|> y ("lux f64 /" x) atan ("lux f64 -" pi))) + + ... ("lux f64 =" +0.0 x) + (cond ("lux f64 <" y +0.0) + (|> pi ("lux f64 /" +2.0)) + + ("lux f64 <" +0.0 y) + (|> pi ("lux f64 /" -2.0)) + + ... ("lux f64 =" +0.0 y) + ("lux f64 /" +0.0 +0.0)))) + +(def: .public (log_by base it) + (-> Frac Frac Frac) + ("lux f64 /" + (..log base) + (..log it))) + +(def: .public (factorial it) + (-> Nat Nat) + (loop [acc 1 + it it] + (if (//nat.> 1 it) + (again (//nat.* it acc) (-- it)) + acc))) + +(def: .public (hypotenuse catA catB) + (-> Frac Frac Frac) + (..pow +0.5 ("lux f64 +" + (..pow +2.0 catA) + (..pow +2.0 catB)))) + +... Hyperbolic functions +... https://en.wikipedia.org/wiki/Hyperbolic_function#Definitions +(template [<name> <comp> <inverse>] + [(def: .public (<name> it) + (-> Frac Frac) + (|> (..exp it) (<comp> (..exp ("lux f64 *" -1.0 it))) ("lux f64 /" +2.0))) + + (def: .public (<inverse> it) + (-> Frac Frac) + (|> +2.0 ("lux f64 /" (|> (..exp it) (<comp> (..exp ("lux f64 *" -1.0 it)))))))] + + [sinh "lux f64 -" csch] + [cosh "lux f64 +" sech] + ) + +(template [<name> <top> <bottom>] + [(def: .public (<name> it) + (-> Frac Frac) + (let [e+ (exp it) + e- (exp ("lux f64 *" -1.0 it)) + sinh' (|> e+ ("lux f64 -" e-)) + cosh' (|> e+ ("lux f64 +" e-))] + (|> <top> ("lux f64 /" <bottom>))))] + + [tanh sinh' cosh'] + [coth cosh' sinh'] + ) + +... https://en.wikipedia.org/wiki/Inverse_hyperbolic_functions#Definitions_in_terms_of_logarithms +(template [<name> <comp>] + [(def: .public (<name> it) + (-> Frac Frac) + (|> it (pow +2.0) (<comp> +1.0) (pow +0.5) ("lux f64 +" it) log))] + + [asinh "lux f64 +"] + [acosh "lux f64 -"] + ) + +(template [<name> <base> <diff>] + [(def: .public (<name> it) + (-> Frac Frac) + (let [it+ (|> <base> ("lux f64 +" <diff>)) + it- (|> <base> ("lux f64 -" <diff>))] + (|> it+ ("lux f64 /" it-) log ("lux f64 /" +2.0))))] + + [atanh +1.0 it] + [acoth it +1.0] + ) + +(template [<name> <op>] + [(def: .public (<name> it) + (-> Frac Frac) + (let [it^2 (|> it (pow +2.0))] + (|> +1.0 (<op> it^2) (pow +0.5) ("lux f64 +" +1.0) ("lux f64 /" it) log)))] + + [asech "lux f64 -"] + [acsch "lux f64 +"] + ) + +(template [<name> <op>] + [(def: .public (<name> param subject) + (-> Frac Frac Bit) + (<op> param subject))] + + [= "lux f64 ="] + [< "lux f64 <"] + ) (def: .public (<= reference sample) (-> Frac Frac Bit) @@ -167,13 +573,13 @@ (def: .public smallest Frac - (///.pow (//int.frac (//int.- (.int ..mantissa_size) ..min_exponent)) - +2.0)) + (..pow (//int.frac (//int.- (.int ..mantissa_size) ..min_exponent)) + +2.0)) (def: .public biggest Frac - (let [f2^-52 (///.pow (//nat.frac (//nat.- ..mantissa_size 0)) +2.0) - f2^+1023 (///.pow ..max_exponent +2.0)] + (let [f2^-52 (..pow (//nat.frac (//nat.- ..mantissa_size 0)) +2.0) + f2^+1023 (..pow ..max_exponent +2.0)] (|> +2.0 (..- f2^-52) (..* f2^+1023)))) @@ -214,8 +620,8 @@ (def: log/2 (-> Frac Frac) - (|>> ///.log - (../ (///.log +2.0)))) + (|>> ..log + (../ (..log +2.0)))) (def: double_bias Nat 1023) @@ -268,7 +674,7 @@ it (..abs it) exponent (|> it ..log/2 - ///.floor + ..floor (..min ..max_exponent)) min_gap (..- (//int.frac ..min_exponent) exponent) power (|> (//nat.frac ..mantissa_size) @@ -276,9 +682,9 @@ (..- exponent)) max_gap (..- ..max_exponent power) mantissa (|> it - (..* (///.pow (..min ..max_exponent power) +2.0)) + (..* (..pow (..min ..max_exponent power) +2.0)) (..* (if (..> +0.0 max_gap) - (///.pow max_gap +2.0) + (..pow max_gap +2.0) +1.0))) exponent_bits (|> (if (..< +0.0 min_gap) (|> (..int exponent) @@ -339,7 +745,7 @@ (//int.- (.int ..mantissa_size)))] [(//i64.one ..mantissa_size M) (|> E (//nat.- ..double_bias) (//nat.- ..mantissa_size) .int)]) - exponent (///.pow (//int.frac power) +2.0)] + exponent (..pow (//int.frac power) +2.0)] (|> (//nat.frac mantissa) (..* exponent) (..* sign))))) diff --git a/stdlib/source/library/lux/math/number/int.lux b/stdlib/source/library/lux/math/number/int.lux index 8214514a7..7d8d19fe6 100644 --- a/stdlib/source/library/lux/math/number/int.lux +++ b/stdlib/source/library/lux/math/number/int.lux @@ -21,13 +21,14 @@ ["[1][0]" nat] ["[1][0]" i64]]) -(def: .public (= reference sample) - (-> Int Int Bit) - ("lux i64 =" reference sample)) +(template [<name> <op>] + [(def: .public (<name> param subject) + (-> Int Int Bit) + (<op> param subject))] -(def: .public (< reference sample) - (-> Int Int Bit) - ("lux i64 <" reference sample)) + [= "lux i64 ="] + [< "lux i64 <"] + ) (def: .public (<= reference sample) (-> Int Int Bit) @@ -55,27 +56,27 @@ [..= zero?] ) -(template [<name> <test> <doc>] +(template [<name> <test>] [(def: .public (<name> left right) (-> Int Int Int) (if (<test> right left) left right))] - [min ..< "Int(eger) minimum."] - [max ..> "Int(eger) maximum."] + [min ..<] + [max ..>] ) -(template [<name> <op> <doc>] +(template [<name> <op>] [(def: .public (<name> param subject) (-> Int Int Int) (<op> param subject))] - [+ "lux i64 +" "Int(eger) addition."] - [- "lux i64 -" "Int(eger) substraction."] - [* "lux i64 *" "Int(eger) multiplication."] - [/ "lux i64 /" "Int(eger) division."] - [% "lux i64 %" "Int(eger) remainder."] + [+ "lux i64 +"] + [- "lux i64 -"] + [* "lux i64 *"] + [/ "lux i64 /"] + [% "lux i64 %"] ) (def: .public (/% param subject) diff --git a/stdlib/source/library/lux/math/number/nat.lux b/stdlib/source/library/lux/math/number/nat.lux index c52647e32..9ead2ee82 100644 --- a/stdlib/source/library/lux/math/number/nat.lux +++ b/stdlib/source/library/lux/math/number/nat.lux @@ -49,9 +49,8 @@ (def: .public (<= reference sample) (-> Nat Nat Bit) - (if (..< reference sample) - #1 - ("lux i64 =" reference sample))) + (or (..< reference sample) + ("lux i64 =" reference sample))) (def: .public (> reference sample) (-> Nat Nat Bit) @@ -59,9 +58,8 @@ (def: .public (>= reference sample) (-> Nat Nat Bit) - (if (..< sample reference) - #1 - ("lux i64 =" reference sample))) + (or (..< sample reference) + ("lux i64 =" reference sample))) (template [<name> <test>] [(def: .public (<name> left right) diff --git a/stdlib/source/library/lux/math/number/rev.lux b/stdlib/source/library/lux/math/number/rev.lux index 8b5e28996..f00cc8dd7 100644 --- a/stdlib/source/library/lux/math/number/rev.lux +++ b/stdlib/source/library/lux/math/number/rev.lux @@ -53,9 +53,8 @@ (def: .public (<= reference sample) (-> Rev Rev Bit) - (if (//nat.< (.nat reference) (.nat sample)) - true - ("lux i64 =" reference sample))) + (or (//nat.< (.nat reference) (.nat sample)) + ("lux i64 =" reference sample))) (def: .public (> reference sample) (-> Rev Rev Bit) @@ -63,9 +62,8 @@ (def: .public (>= reference sample) (-> Rev Rev Bit) - (if (..< sample reference) - true - ("lux i64 =" reference sample))) + (or (..< sample reference) + ("lux i64 =" reference sample))) (template [<name> <test>] [(def: .public (<name> left right) diff --git a/stdlib/source/library/lux/static.lux b/stdlib/source/library/lux/static.lux index e8d213dd8..e4ccd2c3c 100644 --- a/stdlib/source/library/lux/static.lux +++ b/stdlib/source/library/lux/static.lux @@ -1,7 +1,7 @@ (.using [library [lux {"-" nat int rev if cond} - ["[0]" meta] + ["[0]" meta ("[1]#[0]" functor)] [abstract [monad {"+" do}]] [control @@ -57,6 +57,9 @@ .let [[format expression] (:as <type> pair)]] (in (list#each format expression))))) +(syntax: .public (seed []) + (meta#each (|>> code.nat list) meta.seed)) + (template [<name> <random> <format>] [(syntax: .public (<name> []) (do meta.monad @@ -117,3 +120,11 @@ (~ else)))) else (list.reversed test,then/*))))) + +(syntax: .public (when [test <code>.any + then <code>.any]) + (do meta.monad + [test (meta.eval .Bit test)] + (in (.if (:as .Bit test) + (list then) + (list))))) diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux index a8a5ffbc1..b9211ceb0 100644 --- a/stdlib/source/program/aedifex/command/build.lux +++ b/stdlib/source/program/aedifex/command/build.lux @@ -269,7 +269,8 @@ _ (revised ///runtime.#parameters - (|>> (list& "-cp" (..jvm_class_path host_dependencies))) + (|>> (list& "-cp" (..jvm_class_path host_dependencies) + "--add-opens" "java.base/java.lang=ALL-UNNAMED")) runtime))) (def: .public (do! console program fs shell resolution) diff --git a/stdlib/source/program/aedifex/runtime.lux b/stdlib/source/program/aedifex/runtime.lux index 9179dc2e8..57d18d265 100644 --- a/stdlib/source/program/aedifex/runtime.lux +++ b/stdlib/source/program/aedifex/runtime.lux @@ -21,9 +21,10 @@ (def: .public equivalence (Equivalence Runtime) - (product.equivalence - text.equivalence - (list.equivalence text.equivalence))) + ($_ product.equivalence + text.equivalence + (list.equivalence text.equivalence) + )) (template [<name> <command> <parameters>] [(def: .public <name> @@ -31,7 +32,7 @@ [#program <command> #parameters (`` (list (~~ (template.spliced <parameters>))))])] - [default_java "java" ["-jar" "--add-opens" "java.base/java.lang=ALL-UNNAMED"]] + [default_java "java" ["--add-opens" "java.base/java.lang=ALL-UNNAMED" "-jar"]] [default_js "node" ["--stack_size=8192"]] [default_python "python3" []] [default_lua "lua" []] diff --git a/stdlib/source/test/lux/data/color.lux b/stdlib/source/test/lux/data/color.lux index 8df8e5813..a8b175c3a 100644 --- a/stdlib/source/test/lux/data/color.lux +++ b/stdlib/source/test/lux/data/color.lux @@ -11,15 +11,13 @@ [data [collection ["[0]" list]]] - [macro - ["[0]" template]] - ["[0]" math + [math ["[0]" random {"+" Random}] [number ["n" nat] - ["[0]" int] ["f" frac] - ["r" rev]]]]] + ["r" rev] + ["[0]" int]]]]] [\\library ["[0]" /]]) @@ -34,11 +32,11 @@ (def: square (-> Frac Frac) - (math.pow +2.0)) + (f.pow +2.0)) (def: square_root (-> Frac Frac) - (math.pow +0.5)) + (f.pow +0.5)) (def: (distance/1 from to) (-> Frac Frac Frac) diff --git a/stdlib/source/test/lux/math.lux b/stdlib/source/test/lux/math.lux index aeadbf093..6b5c9749e 100644 --- a/stdlib/source/test/lux/math.lux +++ b/stdlib/source/test/lux/math.lux @@ -4,6 +4,8 @@ ["_" test {"+" Test}] [abstract [monad {"+" do}]] + [data + ["[0]" bit ("[1]#[0]" equivalence)]] [macro ["[0]" template]] [math @@ -11,7 +13,10 @@ [number ["n" nat] ["i" int] - ["f" frac]]]]] + ["r" rev] + ["f" frac] + ["[0]" ratio {"+" Ratio}] + ["[0]" complex {"+" Complex}]]]]] [\\library ["[0]" /]] ["[0]" / "_" @@ -23,152 +28,117 @@ ["[1]/[0]" continuous] ["[1]/[0]" fuzzy]]]) -(def: margin_of_error - +0.0000001) +(def: ratio/0 + Ratio + [ratio.#numerator 0 ratio.#denominator 1]) -(def: (trigonometric_symmetry forward backward angle) - (-> (-> Frac Frac) (-> Frac Frac) Frac Bit) - (let [normal (|> angle forward backward)] - (|> normal forward backward (f.approximately? ..margin_of_error normal)))) +(def: complex/0 + Complex + [complex.#real +0.0 complex.#imaginary +0.0]) (def: .public test Test (<| (_.covering /._) - ($_ _.and - (do [! random.monad] - [.let [~= (f.approximately? ..margin_of_error)] - angle (|> random.safe_frac (# ! each (f.* /.tau)))] - ($_ _.and - (_.cover [/.sin /.asin] - (trigonometric_symmetry /.sin /.asin angle)) - (_.cover [/.cos /.acos] - (trigonometric_symmetry /.cos /.acos angle)) - (_.cover [/.tan /.atan] - (trigonometric_symmetry /.tan /.atan angle)) - (_.cover [/.tau] - (and (and (~= +0.0 (/.sin /.tau)) - (~= +1.0 (/.cos /.tau))) - (and (~= +0.0 (/.sin (f./ +2.0 /.tau))) - (~= -1.0 (/.cos (f./ +2.0 /.tau)))) - (and (~= +1.0 (/.sin (f./ +4.0 /.tau))) - (~= +0.0 (/.cos (f./ +4.0 /.tau)))) - (and (~= -1.0 (/.sin (f.* +3.0 (f./ +4.0 /.tau)))) - (~= +0.0 (/.cos (f.* +3.0 (f./ +4.0 /.tau))))) - (let [x2+y2 (f.+ (/.pow +2.0 (/.sin angle)) - (/.pow +2.0 (/.cos angle)))] - (~= +1.0 x2+y2)))) - (_.cover [/.pi] - (~= (f./ +2.0 /.tau) /.pi)) - )) - (do [! random.monad] - [sample (|> random.safe_frac (# ! each (f.* +1000.0)))] - ($_ _.and - (_.cover [/.ceil] - (let [ceil'd (/.ceil sample)] - (and (|> ceil'd f.int i.frac (f.= ceil'd)) - (f.>= sample ceil'd) - (f.<= +1.0 (f.- sample ceil'd))))) - (_.cover [/.floor] - (let [floor'd (/.floor sample)] - (and (|> floor'd f.int i.frac (f.= floor'd)) - (f.<= sample floor'd) - (f.<= +1.0 (f.- floor'd sample))))) - (_.cover [/.round] - (let [round'd (/.round sample)] - (and (|> round'd f.int i.frac (f.= round'd)) - (f.<= +1.0 (f.abs (f.- sample round'd)))))) - (_.cover [/.root/2] - (let [sample (f.abs sample)] - (|> sample - /.root/2 - (/.pow +2.0) - (f.approximately? ..margin_of_error sample)))) - (_.cover [/.root/3] - (|> sample - /.root/3 - (/.pow +3.0) - (f.approximately? ..margin_of_error sample))) - )) - (do [! random.monad] - [.let [~= (f.approximately? ..margin_of_error)] - sample (# ! each (f.* +10.0) random.safe_frac) - power (# ! each (|>> (n.% 10) ++ n.frac) random.nat)] - ($_ _.and - (_.cover [/.exp /.log] - (|> sample /.exp /.log (f.approximately? +0.000000000000001 sample))) - (_.cover [/.e] - (~= +1.0 (/.log /.e))) - (_.cover [/.pow /.log_by] - (let [sample (f.abs sample)] - (|> sample - (/.pow power) - (/.log_by sample) - (~= power)))) - )) - (do [! random.monad] - [.let [~= (f.approximately? ..margin_of_error)] - angle (# ! each (f.* /.tau) random.safe_frac) - sample (# ! each f.abs random.safe_frac) - big (# ! each (f.* +1,000,000,000.00) random.safe_frac)] - (template.let [(odd! <function>) - [(_.cover [<function>] - (~= (f.opposite (<function> angle)) - (<function> (f.opposite angle))))] + (do random.monad + [parameterN (random.only (|>> (n.= 0) not) random.nat) + subjectN random.nat - (even! <function>) - [(_.cover [<function>] - (~= (<function> angle) - (<function> (f.opposite angle))))] + parameterI (random.only (|>> (i.= +0) not) random.int) + subjectI random.int - (inverse! <left> <right> <input>) - [(_.cover [<left> <right>] - (~= (<right> <input>) - (<left> (f./ <input> +1.0))))]] - ($_ _.and - (odd! /.sinh) - (even! /.cosh) - (odd! /.tanh) - (odd! /.coth) - (even! /.sech) - (odd! /.csch) + parameterR (random.only (|>> (r.= .0) not) random.rev) + subjectR random.rev - (inverse! /.acosh /.asech sample) - (inverse! /.asinh /.acsch sample) - (inverse! /.atanh /.acoth big) - ))) - (do [! random.monad] - [x (# ! each (|>> (f.* +10.0) f.abs) random.safe_frac) - y (# ! each (|>> (f.* +10.0) f.abs) random.safe_frac)] - (_.cover [/.hypotenuse] - (let [h (/.hypotenuse x y)] - (and (f.>= x h) - (f.>= y h))))) - (do [! random.monad] - [.let [~= (f.approximately? ..margin_of_error) - tau/4 (f./ +4.0 /.tau)] - x (# ! each (f.* tau/4) random.safe_frac) - y (# ! each (f.* tau/4) random.safe_frac)] - (_.cover [/.atan/2] - (let [expected (/.atan/2 x y) - actual (if (f.> +0.0 x) - (/.atan (f./ x y)) - (if (f.< +0.0 y) - (f.- /.pi (/.atan (f./ x y))) - (f.+ /.pi (/.atan (f./ x y)))))] - (and (~= expected actual) - (~= tau/4 (/.atan/2 +0.0 (f.abs y))) - (~= (f.opposite tau/4) (/.atan/2 +0.0 (f.opposite (f.abs y)))) - (f.not_a_number? (/.atan/2 +0.0 +0.0)))))) - (do [! random.monad] - [of (# ! each (|>> (n.% 10) ++) random.nat)] - (_.cover [/.factorial] - (and (n.= 1 (/.factorial 0)) - (|> (/.factorial of) (n.% of) (n.= 0))))) + parameterF (random.only (|>> (f.= +0.0) not) random.safe_frac) + subjectF random.safe_frac - /infix.test - /modulus.test - /modular.test - /number.test - /logic/continuous.test - /logic/fuzzy.test - ))) + parameter/ (random.only (|>> (ratio.= ratio/0) not) random.ratio) + subject/ random.ratio + + parameterC (random.only (|>> (complex.= complex/0) not) random.complex) + subjectC random.complex]) + (`` ($_ _.and + (~~ (template [</> <scenarios>'] + [(_.cover [</>] + (with_expansions [<scenarios> (template.spliced <scenarios>')] + (`` (and (~~ (template [<=> <//> <parameter> <subject>] + [(<=> (<//> <parameter> <subject>) + (</> <parameter> <subject>))] + + <scenarios>))))))] + + [/.+ [[n.= n.+ parameterN subjectN] + [i.= i.+ parameterI subjectI] + [r.= r.+ parameterR subjectR] + [f.= f.+ parameterF subjectF] + [ratio.= ratio.+ parameter/ subject/] + [complex.= complex.+ parameterC subjectC]]] + [/.- [[n.= n.- parameterN subjectN] + [i.= i.- parameterI subjectI] + [r.= r.- parameterR subjectR] + [f.= f.- parameterF subjectF] + [ratio.= ratio.- parameter/ subject/] + [complex.= complex.- parameterC subjectC]]] + [/.* [[n.= n.* parameterN subjectN] + [i.= i.* parameterI subjectI] + [r.= r.* parameterR subjectR] + [f.= f.* parameterF subjectF] + [ratio.= ratio.* parameter/ subject/] + [complex.= complex.* parameterC subjectC]]] + [/./ [[n.= n./ parameterN subjectN] + [i.= i./ parameterI subjectI] + [r.= r./ parameterR subjectR] + [f.= f./ parameterF subjectF] + [ratio.= ratio./ parameter/ subject/] + [complex.= complex./ parameterC subjectC]]] + [/.% [[n.= n.% parameterN subjectN] + [i.= i.% parameterI subjectI] + [r.= r.% parameterR subjectR] + [f.= f.% parameterF subjectF] + [ratio.= ratio.% parameter/ subject/] + [complex.= complex.% parameterC subjectC]]] + )) + (~~ (template [</> <scenarios>'] + [(_.cover [</>] + (with_expansions [<scenarios> (template.spliced <scenarios>')] + (`` (and (~~ (template [<//> <parameter> <subject>] + [(bit#= (<//> <parameter> <subject>) + (</> <parameter> <subject>))] + + <scenarios>))))))] + + [/.= [[n.= parameterN subjectN] + [i.= parameterI subjectI] + [r.= parameterR subjectR] + [f.= parameterF subjectF] + [ratio.= parameter/ subject/] + [complex.= parameterC subjectC]]] + [/.< [[n.< parameterN subjectN] + [i.< parameterI subjectI] + [r.< parameterR subjectR] + [f.< parameterF subjectF] + [ratio.< parameter/ subject/]]] + [/.<= [[n.<= parameterN subjectN] + [i.<= parameterI subjectI] + [r.<= parameterR subjectR] + [f.<= parameterF subjectF] + [ratio.<= parameter/ subject/]]] + [/.> [[n.> parameterN subjectN] + [i.> parameterI subjectI] + [r.> parameterR subjectR] + [f.> parameterF subjectF] + [ratio.> parameter/ subject/]]] + [/.>= [[n.>= parameterN subjectN] + [i.>= parameterI subjectI] + [r.>= parameterR subjectR] + [f.>= parameterF subjectF] + [ratio.>= parameter/ subject/]]] + )) + + /infix.test + /modulus.test + /modular.test + /number.test + /logic/continuous.test + /logic/fuzzy.test + )))) diff --git a/stdlib/source/test/lux/math/infix.lux b/stdlib/source/test/lux/math/infix.lux index f52e6dd5f..709a24b0b 100644 --- a/stdlib/source/test/lux/math/infix.lux +++ b/stdlib/source/test/lux/math/infix.lux @@ -1,19 +1,18 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}]] - [data - ["[0]" bit ("[1]#[0]" equivalence)]] - [math - ["[0]" random] - [number - ["n" nat] - ["f" frac]]]]] - [\\library - ["[0]" / - ["[0]" //]]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [data + ["[0]" bit ("[1]#[0]" equivalence)]] + [math + ["[0]" random] + [number + ["n" nat] + ["f" frac]]]]] + [\\library + ["[0]" /]]) (def: .public test Test @@ -30,8 +29,8 @@ (/.infix subject)) unary_functions! - (f.= (//.sin angle) - (/.infix [//.sin angle])) + (f.= (f.sin angle) + (/.infix [f.sin angle])) binary_functions! (n.= (n.gcd parameter subject) diff --git a/stdlib/source/test/lux/math/number/complex.lux b/stdlib/source/test/lux/math/number/complex.lux index 53b8982a2..bfee3adcc 100644 --- a/stdlib/source/test/lux/math/number/complex.lux +++ b/stdlib/source/test/lux/math/number/complex.lux @@ -1,18 +1,15 @@ (.using [library [lux "*" - ["%" data/text/format {"+" format}] ["_" test {"+" Test}] [abstract [monad {"+" do}] [\\specification - ["$[0]" equivalence] - ["$[0]" order] - ["$[0]" codec]]] + ["$[0]" equivalence]]] [data [collection ["[0]" list ("[1]#[0]" functor)]]] - ["[0]" math + [math ["[0]" random {"+" Random}]]]] [\\library ["[0]" / @@ -161,8 +158,8 @@ (let [rem (/.% y x) quotient (|> x (/.- rem) (/./ y)) floored (|> quotient - (revised /.#real math.floor) - (revised /.#imaginary math.floor))] + (revised /.#real f.floor) + (revised /.#imaginary f.floor))] (/.approximately? +0.000000000001 x (|> quotient (/.* y) (/.+ rem))))) @@ -192,7 +189,7 @@ (let [signum_abs (|> x /.signum /.abs)] (or (f.= +0.0 signum_abs) (f.= +1.0 signum_abs) - (f.= (math.pow +0.5 +2.0) signum_abs)))) + (f.= (f.pow +0.5 +2.0) signum_abs)))) (_.cover [/.opposite] (let [own_inverse! (let [there (/.opposite x) diff --git a/stdlib/source/test/lux/math/number/frac.lux b/stdlib/source/test/lux/math/number/frac.lux index f78b23afd..77453c6f2 100644 --- a/stdlib/source/test/lux/math/number/frac.lux +++ b/stdlib/source/test/lux/math/number/frac.lux @@ -14,6 +14,8 @@ ["$[0]" codec]]] [data ["[0]" bit ("[1]#[0]" equivalence)]] + [macro + ["[0]" template]] [math ["[0]" random {"+" Random}]]]] [\\library @@ -126,6 +128,148 @@ @.jvm (as_is <jvm>) (as_is))) +(def: margin_of_error + +0.0000001) + +(def: (trigonometric_symmetry forward backward angle) + (-> (-> Frac Frac) (-> Frac Frac) Frac Bit) + (let [normal (|> angle forward backward)] + (|> normal forward backward (/.approximately? ..margin_of_error normal)))) + +(def: test|math + Test + ($_ _.and + (do [! random.monad] + [.let [~= (/.approximately? ..margin_of_error)] + angle (|> random.safe_frac (# ! each (/.* /.tau)))] + ($_ _.and + (_.cover [/.sin /.asin] + (trigonometric_symmetry /.sin /.asin angle)) + (_.cover [/.cos /.acos] + (trigonometric_symmetry /.cos /.acos angle)) + (_.cover [/.tan /.atan] + (trigonometric_symmetry /.tan /.atan angle)) + (_.cover [/.tau] + (and (and (~= +0.0 (/.sin /.tau)) + (~= +1.0 (/.cos /.tau))) + (and (~= +0.0 (/.sin (/./ +2.0 /.tau))) + (~= -1.0 (/.cos (/./ +2.0 /.tau)))) + (and (~= +1.0 (/.sin (/./ +4.0 /.tau))) + (~= +0.0 (/.cos (/./ +4.0 /.tau)))) + (and (~= -1.0 (/.sin (/.* +3.0 (/./ +4.0 /.tau)))) + (~= +0.0 (/.cos (/.* +3.0 (/./ +4.0 /.tau))))) + (let [x2+y2 (/.+ (/.pow +2.0 (/.sin angle)) + (/.pow +2.0 (/.cos angle)))] + (~= +1.0 x2+y2)))) + (_.cover [/.pi] + (~= (/./ +2.0 /.tau) /.pi)) + )) + (do [! random.monad] + [sample (|> random.safe_frac (# ! each (/.* +1000.0)))] + ($_ _.and + (_.cover [/.ceil] + (let [ceil'd (/.ceil sample)] + (and (|> ceil'd /.int i.frac (/.= ceil'd)) + (/.>= sample ceil'd) + (/.<= +1.0 (/.- sample ceil'd))))) + (_.cover [/.floor] + (let [floor'd (/.floor sample)] + (and (|> floor'd /.int i.frac (/.= floor'd)) + (/.<= sample floor'd) + (/.<= +1.0 (/.- floor'd sample))))) + (_.cover [/.round] + (let [round'd (/.round sample)] + (and (|> round'd /.int i.frac (/.= round'd)) + (/.<= +1.0 (/.abs (/.- sample round'd)))))) + (_.cover [/.root/2] + (let [sample (/.abs sample)] + (|> sample + /.root/2 + (/.pow +2.0) + (/.approximately? ..margin_of_error sample)))) + (_.cover [/.root/3] + (|> sample + /.root/3 + (/.pow +3.0) + (/.approximately? ..margin_of_error sample))) + )) + (do [! random.monad] + [.let [~= (/.approximately? ..margin_of_error)] + sample (# ! each (/.* +10.0) random.safe_frac) + power (# ! each (|>> (n.% 10) ++ n.frac) random.nat)] + ($_ _.and + (_.cover [/.exp /.log] + (|> sample /.exp /.log (/.approximately? +0.000000000000001 sample))) + (_.cover [/.e] + (~= +1.0 (/.log /.e))) + (_.cover [/.pow /.log_by] + (let [sample (/.abs sample)] + (|> sample + (/.pow power) + (/.log_by sample) + (~= power)))) + )) + (do [! random.monad] + [.let [~= (/.approximately? ..margin_of_error)] + angle (# ! each (/.* /.tau) random.safe_frac) + sample (# ! each /.abs random.safe_frac) + big (# ! each (/.* +1,000,000,000.00) random.safe_frac)] + (template.let [(odd! <function>) + [(_.cover [<function>] + (~= (/.opposite (<function> angle)) + (<function> (/.opposite angle))))] + + (even! <function>) + [(_.cover [<function>] + (~= (<function> angle) + (<function> (/.opposite angle))))] + + (inverse! <left> <right> <input>) + [(_.cover [<left> <right>] + (~= (<right> <input>) + (<left> (/./ <input> +1.0))))]] + ($_ _.and + (odd! /.sinh) + (even! /.cosh) + (odd! /.tanh) + (odd! /.coth) + (even! /.sech) + (odd! /.csch) + + (inverse! /.acosh /.asech sample) + (inverse! /.asinh /.acsch sample) + (inverse! /.atanh /.acoth big) + ))) + (do [! random.monad] + [x (# ! each (|>> (/.* +10.0) /.abs) random.safe_frac) + y (# ! each (|>> (/.* +10.0) /.abs) random.safe_frac)] + (_.cover [/.hypotenuse] + (let [h (/.hypotenuse x y)] + (and (/.>= x h) + (/.>= y h))))) + (do [! random.monad] + [.let [~= (/.approximately? ..margin_of_error) + tau/4 (/./ +4.0 /.tau)] + x (# ! each (/.* tau/4) random.safe_frac) + y (# ! each (/.* tau/4) random.safe_frac)] + (_.cover [/.atan/2] + (let [expected (/.atan/2 x y) + actual (if (/.> +0.0 x) + (/.atan (/./ x y)) + (if (/.< +0.0 y) + (/.- /.pi (/.atan (/./ x y))) + (/.+ /.pi (/.atan (/./ x y)))))] + (and (~= expected actual) + (~= tau/4 (/.atan/2 +0.0 (/.abs y))) + (~= (/.opposite tau/4) (/.atan/2 +0.0 (/.opposite (/.abs y)))) + (/.not_a_number? (/.atan/2 +0.0 +0.0)))))) + (do [! random.monad] + [of (# ! each (|>> (n.% 10) ++) random.nat)] + (_.cover [/.factorial] + (and (n.= 1 (/.factorial 0)) + (|> (/.factorial of) (n.% of) (n.= 0))))) + )) + (def: .public test Test (<| (_.covering /._) @@ -242,4 +386,5 @@ ..predicate ..conversion ..signature + ..test|math ))) |