From 6095c8149a4f0c47333d50186f0758d286d30dec Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 12 Dec 2016 20:15:49 -0400 Subject: - Small fixes, refactorings and expansions. --- stdlib/source/lux.lux | 2 +- stdlib/source/lux/data/number.lux | 13 +++++- stdlib/source/lux/math/complex.lux | 5 ++- stdlib/source/lux/math/ratio.lux | 10 ++--- stdlib/source/lux/math/simple.lux | 89 ++++++++++++++++++++++++++++++++++++-- 5 files changed, 104 insertions(+), 15 deletions(-) (limited to 'stdlib/source') 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 [ ] [(struct: #export (Monoid ) @@ -128,6 +129,10 @@ [Mul@Monoid Real 1.0 r.*] [Max@Monoid Real (:: Bounded bottom) r.max] [Min@Monoid Real (:: Bounded top) r.min] + [Add@Monoid Frac (:: Bounded bottom) f.+] + [Mul@Monoid Frac (:: Bounded top) f.*] + [Max@Monoid Frac (:: Bounded bottom) f.max] + [Min@Monoid Frac (:: Bounded 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"] [])]))) + [(#;Right (int-to-nat (_lux_proc ["jvm" "invokestatic:java.lang.Long:parseUnsignedLong:java.lang.String,int"] [repr (_lux_proc ["jvm" "l2i"] [])]))) (lambda [ex] (#;Left ))]))) (macro: #export ( 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 Codec] [text "Text/" Monoid] + text/format error maybe (struct [list "List/" Monad])) @@ -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 Codec] [text "Text/" Monoid] + 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 [ ] + [(syntax: #export ( {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 (` )) + + (and (check;checks? Int =x) + (check;checks? Int =y)) + (wrap (` )) + + (and (check;checks? Real =x) + (check;checks? Real =y)) + (wrap (` )) + + (and (check;checks? Frac =x) + (check;checks? Frac =y)) + (wrap (` )) + + (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)] + ( (~ g!x) (~ g!y))))))) + + (+2 x) + (do @ + [=x (resolve-type x) + op (cond (check;checks? Nat =x) + (wrap (` )) + + (check;checks? Int =x) + (wrap (` )) + + (check;checks? Real =x) + (wrap (` )) + + (check;checks? Frac =x) + (wrap (` )) + + (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)] + ( (~ g!x))))))) + + (+4 []) + (do @ + [=e compiler;expected-type + op (cond (check;checks? (-> Nat Nat Bool) =e) + (wrap (` )) + + (check;checks? (-> Int Int Bool) =e) + (wrap (` )) + + (check;checks? (-> Real Real Bool) =e) + (wrap (` )) + + (check;checks? (-> Frac Frac Bool) =e) + (wrap (` )) + + (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.>=] ) -- cgit v1.2.3