aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux23
-rw-r--r--stdlib/source/lux/compiler/default/phase/translation/scheme/extension/common.jvm.lux27
-rw-r--r--stdlib/source/lux/data/number.lux25
-rw-r--r--stdlib/source/lux/math.lux115
-rw-r--r--stdlib/source/lux/math/infix.lux89
-rw-r--r--stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux31
-rw-r--r--stdlib/test/test/lux/math.lux15
7 files changed, 123 insertions, 202 deletions
diff --git a/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux b/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux
index d4e94a36f..437a54bbc 100644
--- a/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux
+++ b/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux
@@ -240,28 +240,6 @@
(bundle.install "size" (unary (type (Ex [a] (Array a))) Nat))
)))
-(def: bundle::math
- Bundle
- (<| (bundle.prefix "math")
- (|> bundle.empty
- (bundle.install "cos" (unary Frac Frac))
- (bundle.install "sin" (unary Frac Frac))
- (bundle.install "tan" (unary Frac Frac))
- (bundle.install "acos" (unary Frac Frac))
- (bundle.install "asin" (unary Frac Frac))
- (bundle.install "atan" (unary Frac Frac))
- (bundle.install "cosh" (unary Frac Frac))
- (bundle.install "sinh" (unary Frac Frac))
- (bundle.install "tanh" (unary Frac Frac))
- (bundle.install "exp" (unary Frac Frac))
- (bundle.install "log" (unary Frac Frac))
- (bundle.install "ceil" (unary Frac Frac))
- (bundle.install "floor" (unary Frac Frac))
- (bundle.install "round" (unary Frac Frac))
- (bundle.install "atan2" (binary Frac Frac Frac))
- (bundle.install "pow" (binary Frac Frac Frac))
- )))
-
(def: atom::new
Handler
(function (_ extension-name analyse args)
@@ -362,7 +340,6 @@
(dict.merge bundle::frac)
(dict.merge bundle::text)
(dict.merge bundle::array)
- (dict.merge bundle::math)
(dict.merge bundle::atom)
(dict.merge bundle::box)
(dict.merge bundle::process)
diff --git a/stdlib/source/lux/compiler/default/phase/translation/scheme/extension/common.jvm.lux b/stdlib/source/lux/compiler/default/phase/translation/scheme/extension/common.jvm.lux
index 9952a754d..a508dfabd 100644
--- a/stdlib/source/lux/compiler/default/phase/translation/scheme/extension/common.jvm.lux
+++ b/stdlib/source/lux/compiler/default/phase/translation/scheme/extension/common.jvm.lux
@@ -250,32 +250,6 @@
(bundle.install "char" (binary text::char))
(bundle.install "clip" (trinary text::clip)))))
-## [[Math]]
-(def: (math::pow [subject param])
- Binary
- (_.expt/2 param subject))
-
-(def: math-func
- (-> Text Unary)
- (|>> _.global _.apply/1))
-
-(def: bundle::math
- Bundle
- (<| (bundle.prefix "math")
- (|> bundle.empty
- (bundle.install "cos" (unary (math-func "cos")))
- (bundle.install "sin" (unary (math-func "sin")))
- (bundle.install "tan" (unary (math-func "tan")))
- (bundle.install "acos" (unary (math-func "acos")))
- (bundle.install "asin" (unary (math-func "asin")))
- (bundle.install "atan" (unary (math-func "atan")))
- (bundle.install "exp" (unary (math-func "exp")))
- (bundle.install "log" (unary (math-func "log")))
- (bundle.install "ceil" (unary (math-func "ceiling")))
- (bundle.install "floor" (unary (math-func "floor")))
- (bundle.install "pow" (binary math::pow))
- )))
-
## [[IO]]
(def: (io::log input)
Unary
@@ -352,7 +326,6 @@
(dict.merge bundle::frac)
(dict.merge bundle::text)
(dict.merge bundle::array)
- (dict.merge bundle::math)
(dict.merge bundle::io)
(dict.merge bundle::atom)
(dict.merge bundle::box)
diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux
index 13ffe71da..583a03b1f 100644
--- a/stdlib/source/lux/data/number.lux
+++ b/stdlib/source/lux/data/number.lux
@@ -12,7 +12,8 @@
[data
["." error (#+ Error)]
["." maybe]
- ["." text]]]
+ ["." text]]
+ ["." math]]
[/
["." i64]])
@@ -142,8 +143,8 @@
Frac
(f// +0.0 <numerator>))]
- [not-a-number +0.0 "Not a number."]
- [positive-infinity +1.0 "Positive infinity."]
+ [not-a-number +0.0 "Not a number."]
+ [positive-infinity +1.0 "Positive infinity."]
[negative-infinity -1.0 "Negative infinity."]
)
@@ -923,8 +924,8 @@
(def: (log2 input)
(-> Frac Frac)
- (f// ("lux math log" +2.0)
- ("lux math log" input)))
+ (f// (math.log +2.0)
+ (math.log input)))
(def: double-bias Nat 1023)
@@ -953,13 +954,13 @@
## else
(let [sign (:: Number<Frac> signum input)
input (:: Number<Frac> abs input)
- exponent ("lux math floor" (log2 input))
+ exponent (math.floor (log2 input))
exponent-mask (|> 1 (i64.left-shift exponent-size) dec)
mantissa (|> input
## Normalize
- (f// ("lux math pow" +2.0 exponent))
+ (f// (math.pow exponent +2.0))
## Make it int-equivalent
- (f/* ("lux math pow" +2.0 +52.0)))
+ (f/* (math.pow +52.0 +2.0)))
sign-bit (if (f/= -1.0 sign) 1 0)
exponent-bits (|> exponent frac-to-int .nat (n/+ double-bias) (i64.and exponent-mask))
mantissa-bits (|> mantissa frac-to-int .nat)]
@@ -1000,10 +1001,10 @@
## else
(let [normalized (|> M (i64.set mantissa-size)
.int int-to-frac
- (f// ("lux math pow" +2.0 +52.0)))
- power (|> E (n/- double-bias)
- .int int-to-frac
- ("lux math pow" +2.0))
+ (f// (math.pow +52.0 +2.0)))
+ power (math.pow (|> E (n/- double-bias)
+ .int int-to-frac)
+ +2.0)
shifted (f/* power
normalized)]
(if (n/= 0 S)
diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux
index cdaf54461..d4650426f 100644
--- a/stdlib/source/lux/math.lux
+++ b/stdlib/source/lux/math.lux
@@ -1,16 +1,5 @@
(.module: {#.doc "Common mathematical constants and functions."}
- [lux #*
- [control
- monad
- ["p" parser ("parser/." Functor<Parser>)]]
- [data
- ["." product]
- ["." number]
- [collection
- [list ("list/." Fold<List>)]]]
- ["." macro
- ["s" syntax (#+ syntax: Syntax)]
- ["." code]]])
+ [lux #*])
## [Values]
(do-template [<name> <value> <doc>]
@@ -29,19 +18,19 @@
(-> Frac Frac)
(<method> input))]
- [cos "lux math cos"]
- [sin "lux math sin"]
- [tan "lux math tan"]
+ [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 "lux math acos"]
- [asin "lux math asin"]
- [atan "lux math atan"]
+ [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 "lux math exp"]
- [log "lux math log"]
+ [exp "jvm invokestatic:java.lang.Math:exp:double"]
+ [log "jvm invokestatic:java.lang.Math:log:double"]
- [ceil "lux math ceil"]
- [floor "lux math floor"]
+ [ceil "jvm invokestatic:java.lang.Math:ceil:double"]
+ [floor "jvm invokestatic:java.lang.Math:floor:double"]
)
(def: #export (round input)
@@ -59,7 +48,7 @@
(def: #export (pow param subject)
(-> Frac Frac Frac)
- ("lux math pow" subject param))
+ ("jvm invokestatic:java.lang.Math:pow:double,double" subject param))
(def: #export (atan2 param subject)
(-> Frac Frac Frac)
@@ -79,7 +68,7 @@
(|> pi (f// -2.0))
## (f/= +0.0 subject)
- number.not-a-number)))
+ (f// +0.0 +0.0))))
(def: #export (log' base input)
(-> Frac Frac Frac)
@@ -180,81 +169,3 @@
[asech f/-]
[acsch f/+]
)
-
-## [Syntax]
-(type: #rec Infix
- (#Const Code)
- (#Call (List Code))
- (#Unary Code Infix)
- (#Binary Infix Code Infix))
-
-(def: infix^
- (Syntax Infix)
- (<| p.rec (function (_ infix^))
- ($_ p.or
- ($_ p.either
- (parser/map code.bit s.bit)
- (parser/map code.nat s.nat)
- (parser/map code.int s.int)
- (parser/map code.rev s.rev)
- (parser/map code.frac s.frac)
- (parser/map code.text s.text)
- (parser/map code.identifier s.identifier)
- (parser/map code.tag s.tag))
- (s.form (p.many s.any))
- (s.tuple (p.and s.any infix^))
- (s.tuple ($_ p.either
- (do p.Monad<Parser>
- [_ (s.this (' #and))
- init-subject infix^
- init-op s.any
- init-param infix^
- steps (p.some (p.and s.any infix^))]
- (wrap (product.right (list/fold (function (_ [op param] [subject [_subject _op _param]])
- [param [(#Binary _subject _op _param)
- (` and)
- (#Binary subject op param)]])
- [init-param [init-subject init-op init-param]]
- steps))))
- (do p.Monad<Parser>
- [init-subject infix^
- init-op s.any
- init-param infix^
- steps (p.some (p.and s.any infix^))]
- (wrap (list/fold (function (_ [op param] [_subject _op _param])
- [(#Binary _subject _op _param) op param])
- [init-subject init-op init-param]
- steps)))
- ))
- )))
-
-(def: (infix-to-prefix infix)
- (-> Infix Code)
- (case infix
- (#Const value)
- value
-
- (#Call parts)
- (code.form parts)
-
- (#Unary op subject)
- (` ((~ op) (~ (infix-to-prefix subject))))
-
- (#Binary left op right)
- (` ((~ op) (~ (infix-to-prefix right)) (~ (infix-to-prefix left))))
- ))
-
-(syntax: #export (infix {expr infix^})
- {#.doc (doc "Infix math syntax."
- (infix [x i/* +10])
- (infix [[x i/+ y] i/* [x i/- y]])
- (infix [sin [x i/+ y]])
- (infix [[x n/< y] and [y n/< z]])
- (infix [#and x n/< y n/< z])
- (infix [(n/* 3 9) gcd 450])
-
- "The rules for infix syntax are simple."
- "If you want your binary function to work well with it."
- "Then take the argument to the right (y) as your first argument,"
- "and take the argument to the left (x) as your second argument.")}
- (wrap (list (infix-to-prefix expr))))
diff --git a/stdlib/source/lux/math/infix.lux b/stdlib/source/lux/math/infix.lux
new file mode 100644
index 000000000..145b8f579
--- /dev/null
+++ b/stdlib/source/lux/math/infix.lux
@@ -0,0 +1,89 @@
+(.module: {#.doc "Common mathematical constants and functions."}
+ [lux #*
+ [control
+ monad
+ ["p" parser ("parser/." Functor<Parser>)]]
+ [data
+ ["." product]
+ [collection
+ [list ("list/." Fold<List>)]]]
+ [macro
+ ["s" syntax (#+ syntax: Syntax)]
+ ["." code]]])
+
+(type: #rec Infix
+ (#Const Code)
+ (#Call (List Code))
+ (#Unary Code Infix)
+ (#Binary Infix Code Infix))
+
+(def: infix^
+ (Syntax Infix)
+ (<| p.rec (function (_ infix^))
+ ($_ p.or
+ ($_ p.either
+ (parser/map code.bit s.bit)
+ (parser/map code.nat s.nat)
+ (parser/map code.int s.int)
+ (parser/map code.rev s.rev)
+ (parser/map code.frac s.frac)
+ (parser/map code.text s.text)
+ (parser/map code.identifier s.identifier)
+ (parser/map code.tag s.tag))
+ (s.form (p.many s.any))
+ (s.tuple (p.and s.any infix^))
+ (s.tuple ($_ p.either
+ (do p.Monad<Parser>
+ [_ (s.this (' #and))
+ init-subject infix^
+ init-op s.any
+ init-param infix^
+ steps (p.some (p.and s.any infix^))]
+ (wrap (product.right (list/fold (function (_ [op param] [subject [_subject _op _param]])
+ [param [(#Binary _subject _op _param)
+ (` and)
+ (#Binary subject op param)]])
+ [init-param [init-subject init-op init-param]]
+ steps))))
+ (do p.Monad<Parser>
+ [init-subject infix^
+ init-op s.any
+ init-param infix^
+ steps (p.some (p.and s.any infix^))]
+ (wrap (list/fold (function (_ [op param] [_subject _op _param])
+ [(#Binary _subject _op _param) op param])
+ [init-subject init-op init-param]
+ steps)))
+ ))
+ )))
+
+(def: (infix-to-prefix infix)
+ (-> Infix Code)
+ (case infix
+ (#Const value)
+ value
+
+ (#Call parts)
+ (code.form parts)
+
+ (#Unary op subject)
+ (` ((~ op) (~ (infix-to-prefix subject))))
+
+ (#Binary left op right)
+ (` ((~ op) (~ (infix-to-prefix right)) (~ (infix-to-prefix left))))
+ ))
+
+(syntax: #export (infix {expr infix^})
+ {#.doc (doc "Infix math syntax."
+ (infix [x i/* +10])
+ (infix [[x i/+ y] i/* [x i/- y]])
+ (infix [sin [x i/+ y]])
+ (infix [[x n/< y] and [y n/< z]])
+ (infix [#and x n/< y n/< z])
+ (infix [(n/* 3 9) gcd 450])
+
+ "The rules for infix syntax are simple."
+ "If you want your binary function to work well with it."
+ "Then take the argument to the right (y) as your first argument,"
+ "and take the argument to the left (x) as your second argument.")}
+ (wrap (list (infix-to-prefix expr))))
diff --git a/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux b/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux
index 5fc04278b..8d3e8b8fa 100644
--- a/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux
+++ b/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux
@@ -207,37 +207,6 @@
(` ("lux array size" (~ g!array)))))
))))
-(context: "Math procedures"
- (<| (times 100)
- (do @
- [subjectC (|> r.frac (:: @ map code.frac))
- paramC (|> r.frac (:: @ map code.frac))]
- (`` ($_ seq
- (~~ (do-template [<proc> <desc>]
- [(test (format "Can calculate " <desc> ".")
- (check-success+ <proc> (list subjectC) Frac))]
-
- ["lux math cos" "cosine"]
- ["lux math sin" "sine"]
- ["lux math tan" "tangent"]
- ["lux math acos" "inverse/arc cosine"]
- ["lux math asin" "inverse/arc sine"]
- ["lux math atan" "inverse/arc tangent"]
- ["lux math cosh" "hyperbolic cosine"]
- ["lux math sinh" "hyperbolic sine"]
- ["lux math tanh" "hyperbolic tangent"]
- ["lux math exp" "exponentiation"]
- ["lux math log" "logarithm"]
- ["lux math ceil" "ceiling"]
- ["lux math floor" "floor"]
- ["lux math round" "rounding"]))
- (~~ (do-template [<proc> <desc>]
- [(test (format "Can calculate " <desc> ".")
- (check-success+ <proc> (list subjectC paramC) Frac))]
-
- ["lux math atan2" "inverse/arc tangent (with 2 arguments)"]
- ["lux math pow" "power"])))))))
-
(context: "Atom procedures"
(<| (times 100)
(do @
diff --git a/stdlib/test/test/lux/math.lux b/stdlib/test/test/lux/math.lux
index 4cdb8eed5..059f19c4c 100644
--- a/stdlib/test/test/lux/math.lux
+++ b/stdlib/test/test/lux/math.lux
@@ -6,6 +6,7 @@
[bit ("bit/." Equivalence<Bit>)]
[number ("frac/." Number<Frac>)]]
["&" math
+ infix
["r" random]]]
lux/test)
@@ -98,27 +99,27 @@
($_ seq
(test "Constant values don't change."
(n/= x
- (&.infix x)))
+ (infix x)))
(test "Can call binary functions."
(n/= (&.n/gcd y x)
- (&.infix [x &.n/gcd y])))
+ (infix [x &.n/gcd y])))
(test "Can call unary functions."
(f/= (&.sin theta)
- (&.infix [&.sin theta])))
+ (infix [&.sin theta])))
(test "Can use regular syntax in the middle of infix code."
(n/= (&.n/gcd 450 (n/* 3 9))
- (&.infix [(n/* 3 9) &.n/gcd 450])))
+ (infix [(n/* 3 9) &.n/gcd 450])))
(test "Can use non-numerical functions/macros as operators."
(bit/= (and (n/< y x) (n/< z y))
- (&.infix [[x n/< y] and [y n/< z]])))
+ (infix [[x n/< y] and [y n/< z]])))
(test "Can combine bit operations in special ways via special keywords."
(and (bit/= (and (n/< y x) (n/< z y))
- (&.infix [#and x n/< y n/< z]))
+ (infix [#and x n/< y n/< z]))
(bit/= (and (n/< y x) (n/> z y))
- (&.infix [#and x n/< y n/> z]))))
+ (infix [#and x n/< y n/> z]))))
))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 20:30:46 +0000