aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux.lux2
-rw-r--r--stdlib/source/lux/data/number.lux13
-rw-r--r--stdlib/source/lux/math/complex.lux5
-rw-r--r--stdlib/source/lux/math/ratio.lux10
-rw-r--r--stdlib/source/lux/math/simple.lux89
5 files changed, 104 insertions, 15 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index bff74ff0c..dd8e70ab6 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -2074,7 +2074,7 @@
[ Nat "nat" n.= "=" n.< n.<= "<" n.> n.>=
"Natural equality." "Natural less-than." "Natural less-than-equal." "Natural greater-than." "Natural greater-than-equal."]
- [ Int "jvm" i.= "leq" i.< i.<= "llt" i.> i.>=
+ [ Int "jvm" i.= "leq" i.< i.<= "llt" i.> i.>=
"Integer equality." "Integer less-than." "Integer less-than-equal." "Integer greater-than." "Integer greater-than-equal."]
[Frac "frac" f.= "=" f.< f.<= "<" f.> f.>=
diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux
index 8c3d08dbf..046e681b8 100644
--- a/stdlib/source/lux/data/number.lux
+++ b/stdlib/source/lux/data/number.lux
@@ -109,7 +109,8 @@
[ Nat (_lux_proc ["nat" "max-value"] []) (_lux_proc ["nat" "min-value"] [])]
[ Int (_lux_proc ["jvm" "getstatic:java.lang.Long:MAX_VALUE"] []) (_lux_proc ["jvm" "getstatic:java.lang.Long:MIN_VALUE"] [])]
- [Real (_lux_proc ["jvm" "getstatic:java.lang.Double:MAX_VALUE"] []) (_lux_proc ["jvm" "getstatic:java.lang.Double:MIN_VALUE"] [])])
+ [Real (_lux_proc ["jvm" "getstatic:java.lang.Double:MAX_VALUE"] []) (_lux_proc ["jvm" "getstatic:java.lang.Double:MIN_VALUE"] [])]
+ [Frac (_lux_proc ["frac" "max-value"] []) (_lux_proc ["frac" "max-value"] [])])
(do-template [<name> <type> <unit> <append>]
[(struct: #export <name> (Monoid <type>)
@@ -128,6 +129,10 @@
[Mul@Monoid<Real> Real 1.0 r.*]
[Max@Monoid<Real> Real (:: Bounded<Real> bottom) r.max]
[Min@Monoid<Real> Real (:: Bounded<Real> top) r.min]
+ [Add@Monoid<Frac> Frac (:: Bounded<Frac> bottom) f.+]
+ [Mul@Monoid<Frac> Frac (:: Bounded<Frac> top) f.*]
+ [Max@Monoid<Frac> Frac (:: Bounded<Frac> bottom) f.max]
+ [Min@Monoid<Frac> Frac (:: Bounded<Frac> top) f.min]
)
(def: (text.replace pattern value template)
@@ -197,7 +202,7 @@
(def: (decode repr)
(_lux_proc ["jvm" "try"]
- [(#;Right (int-to-nat (_lux_proc ["jvm" "invokestatic:java.lang.Long:valueOf:java.lang.String,int"] [repr (_lux_proc ["jvm" "l2i"] [<radix>])])))
+ [(#;Right (int-to-nat (_lux_proc ["jvm" "invokestatic:java.lang.Long:parseUnsignedLong:java.lang.String,int"] [repr (_lux_proc ["jvm" "l2i"] [<radix>])])))
(lambda [ex] (#;Left <error>))])))
(macro: #export (<macro> tokens state)
@@ -233,3 +238,7 @@
[+inf "getstatic:java.lang.Double:POSITIVE_INFINITY"]
[-inf "getstatic:java.lang.Double:NEGATIVE_INFINITY"]
)
+
+(def: #export (nan? number)
+ (-> Real Bool)
+ (not (r.= number number)))
diff --git a/stdlib/source/lux/math/complex.lux b/stdlib/source/lux/math/complex.lux
index 6fac976b8..9a2c7c164 100644
--- a/stdlib/source/lux/math/complex.lux
+++ b/stdlib/source/lux/math/complex.lux
@@ -13,6 +13,7 @@
monad)
(data [number "r/" Number<Real> Codec<Text,Real>]
[text "Text/" Monoid<Text>]
+ text/format
error
maybe
(struct [list "List/" Monad<List>]))
@@ -39,8 +40,8 @@
(def: #export zero Complex (complex 0.0 0.0))
(def: #export (nan? complex)
- (or (r.= number;nan (get@ #real complex))
- (r.= number;nan (get@ #imaginary complex))))
+ (or (number;nan? (get@ #real complex))
+ (number;nan? (get@ #imaginary complex))))
(def: #export (c.= param input)
(-> Complex Complex Bool)
diff --git a/stdlib/source/lux/math/ratio.lux b/stdlib/source/lux/math/ratio.lux
index 1baa9a206..c0e077c8a 100644
--- a/stdlib/source/lux/math/ratio.lux
+++ b/stdlib/source/lux/math/ratio.lux
@@ -13,6 +13,7 @@
monad)
(data [number "n/" Number<Nat> Codec<Text,Nat>]
[text "Text/" Monoid<Text>]
+ text/format
error
[product])
[compiler]
@@ -133,14 +134,9 @@
(-> Nat Text)
(|>. n/encode (text;split +1) (default (undefined)) product;right))
-(def: (part-decode part)
+(def: part-decode
(-> Text (Error Nat))
- (case (text;split-with "+" part)
- (#;Some [_ part])
- (n/decode part)
-
- _
- (fail "Invalid format for ratio part.")))
+ (|>. (format "+") n/decode))
(struct: #export _ (Codec Text Ratio)
(def: (encode (^slots [#numerator #denominator]))
diff --git a/stdlib/source/lux/math/simple.lux b/stdlib/source/lux/math/simple.lux
index 9b6e70fbc..bb66e1160 100644
--- a/stdlib/source/lux/math/simple.lux
+++ b/stdlib/source/lux/math/simple.lux
@@ -133,11 +133,94 @@
[* ;;* n.* i.* r.* f.*]
[/ ;;/ n./ i./ r./ f./]
[% ;;% n.% i.% r.% f.%]
+ )
+
+(do-template [<name> <rec> <nat-op> <int-op> <real-op> <frac-op>]
+ [(syntax: #export (<name> {args ($_ s;alt
+ (s;seq s;symbol s;symbol)
+ (s;seq s;any s;any)
+ s;symbol
+ s;any
+ s;end)})
+ (case args
+ (+0 [x y])
+ (do @
+ [=x (resolve-type x)
+ =y (resolve-type y)
+ op (cond (and (check;checks? Nat =x)
+ (check;checks? Nat =y))
+ (wrap (` <nat-op>))
+
+ (and (check;checks? Int =x)
+ (check;checks? Int =y))
+ (wrap (` <int-op>))
+
+ (and (check;checks? Real =x)
+ (check;checks? Real =y))
+ (wrap (` <real-op>))
+
+ (and (check;checks? Frac =x)
+ (check;checks? Frac =y))
+ (wrap (` <frac-op>))
+
+ (compiler;fail (format "No operation for types: " (%type =x) " and " (%type =y))))]
+ (wrap (list (` ((~ op) (~ (ast;symbol x)) (~ (ast;symbol y)))))))
+
+ (+1 [x y])
+ (do @
+ [g!x (compiler;gensym "g!x")
+ g!y (compiler;gensym "g!y")]
+ (wrap (list (` (let [(~ g!x) (~ x)
+ (~ g!y) (~ y)]
+ (<rec> (~ g!x) (~ g!y)))))))
+
+ (+2 x)
+ (do @
+ [=x (resolve-type x)
+ op (cond (check;checks? Nat =x)
+ (wrap (` <nat-op>))
+
+ (check;checks? Int =x)
+ (wrap (` <int-op>))
+
+ (check;checks? Real =x)
+ (wrap (` <real-op>))
+
+ (check;checks? Frac =x)
+ (wrap (` <frac-op>))
+
+ (compiler;fail (format "No operation for type: " (%type =x))))]
+ (wrap (list (` ((~ op) (~ (ast;symbol x)))))))
+
+ (+3 x)
+ (do @
+ [g!x (compiler;gensym "g!x")]
+ (wrap (list (` (let [(~ g!x) (~ x)]
+ (<rec> (~ g!x)))))))
+
+ (+4 [])
+ (do @
+ [=e compiler;expected-type
+ op (cond (check;checks? (-> Nat Nat Bool) =e)
+ (wrap (` <nat-op>))
+
+ (check;checks? (-> Int Int Bool) =e)
+ (wrap (` <int-op>))
+
+ (check;checks? (-> Real Real Bool) =e)
+ (wrap (` <real-op>))
+
+ (check;checks? (-> Frac Frac Bool) =e)
+ (wrap (` <frac-op>))
+
+ (compiler;fail (format "No operation for type: " (%type =e))))]
+ (wrap (list op)))
+ ))]
- [= ;;= n.= i.= r.= f.=]
- [< ;;< n.< i.< r.< f.<]
+ [= ;;= n.= i.= r.= f.=]
+ [< ;;< n.< i.< r.< f.<]
[<= ;;<= n.<= i.<= r.<= f.<=]
- [> ;;> n.> i.> r.> f.>]
+ [> ;;> n.> i.> r.> f.>]
[>= ;;>= n.>= i.>= r.>= f.>=]
)
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-07 01:06:08 +0000