- Implemented some math functions in pure Lux, to reduce the needs of the compiler, and make it easier to port Lux to new backends.

5 files changed, 98 insertions, 54 deletions

diff --git a/.gitignore b/.gitignore
index 6fc9d941c..5ba128725 100644
--- a/.gitignore
+++ b/.gitignore
@@ -13,4 +13,5 @@ pom.xml.asc
 /new-luxc/target
 /new-luxc/commands
 /docs
+/commands
 
diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj
index f43781276..e3cb5a4c8 100644
--- a/luxc/src/lux/analyser/proc/common.clj
+++ b/luxc/src/lux/analyser/proc/common.clj
@@ -378,14 +378,10 @@
   ^:private analyse-math-acos "acos"
   ^:private analyse-math-asin "asin"
   ^:private analyse-math-atan "atan"
-  ^:private analyse-math-cosh "cosh"
-  ^:private analyse-math-sinh "sinh"
-  ^:private analyse-math-tanh "tanh"
   ^:private analyse-math-exp "exp"
   ^:private analyse-math-log "log"
   ^:private analyse-math-ceil "ceil"
   ^:private analyse-math-floor "floor"
-  ^:private analyse-math-round "round"
   )
 
 (do-template [<name> <proc>]
@@ -398,7 +394,6 @@
       (return (&/|list (&&/|meta exo-type _cursor
                                  (&&/$proc (&/T ["math" <proc>]) (&/|list =input =param) (&/|list)))))))
 
-  ^:private analyse-math-atan2 "atan2"
   ^:private analyse-math-pow "pow"
   )
 
@@ -595,15 +590,10 @@
          "lux math acos" (analyse-math-acos analyse exo-type ?values)
          "lux math asin" (analyse-math-asin analyse exo-type ?values)
          "lux math atan" (analyse-math-atan analyse exo-type ?values)
-         "lux math cosh" (analyse-math-cosh analyse exo-type ?values)
-         "lux math sinh" (analyse-math-sinh analyse exo-type ?values)
-         "lux math tanh" (analyse-math-tanh analyse exo-type ?values)
          "lux math exp" (analyse-math-exp analyse exo-type ?values)
          "lux math log" (analyse-math-log analyse exo-type ?values)
          "lux math ceil" (analyse-math-ceil analyse exo-type ?values)
          "lux math floor" (analyse-math-floor analyse exo-type ?values)
-         "lux math round" (analyse-math-round analyse exo-type ?values)
-         "lux math atan2" (analyse-math-atan2 analyse exo-type ?values)
          "lux math pow" (analyse-math-pow analyse exo-type ?values)
          
          "lux atom new" (analyse-atom-new analyse exo-type ?values)
diff --git a/luxc/src/lux/compiler/js/proc/common.clj b/luxc/src/lux/compiler/js/proc/common.clj
index cb16813d9..96261e8d4 100644
--- a/luxc/src/lux/compiler/js/proc/common.clj
+++ b/luxc/src/lux/compiler/js/proc/common.clj
@@ -405,14 +405,10 @@
   ^:private compile-math-acos "acos"
   ^:private compile-math-asin "asin"
   ^:private compile-math-atan "atan"
-  ^:private compile-math-cosh "cosh"
-  ^:private compile-math-sinh "sinh"
-  ^:private compile-math-tanh "tanh"
   ^:private compile-math-exp "exp"
   ^:private compile-math-log "log"
   ^:private compile-math-ceil "ceil"
   ^:private compile-math-floor "floor"
-  ^:private compile-math-round "round"
   )
 
 (do-template [<name> <method>]
@@ -422,7 +418,6 @@
           =param (compile ?param)]
       (return (str "Math." <method> "(" =input "," =param ")"))))
 
-  ^:private compile-math-atan2 "atan2"
   ^:private compile-math-pow "pow"
   )
 
@@ -561,15 +556,10 @@
       "acos" (compile-math-acos compile ?values special-args)
       "asin" (compile-math-asin compile ?values special-args)
       "atan" (compile-math-atan compile ?values special-args)
-      "cosh" (compile-math-cosh compile ?values special-args)
-      "sinh" (compile-math-sinh compile ?values special-args)
-      "tanh" (compile-math-tanh compile ?values special-args)
       "exp" (compile-math-exp compile ?values special-args)
       "log" (compile-math-log compile ?values special-args)
       "ceil" (compile-math-ceil compile ?values special-args)
       "floor" (compile-math-floor compile ?values special-args)
-      "round" (compile-math-round compile ?values special-args)
-      "atan2" (compile-math-atan2 compile ?values special-args)
       "pow" (compile-math-pow compile ?values special-args)
       )
 
diff --git a/luxc/src/lux/compiler/jvm/proc/common.clj b/luxc/src/lux/compiler/jvm/proc/common.clj
index 67536f3fe..e9e565f6d 100644
--- a/luxc/src/lux/compiler/jvm/proc/common.clj
+++ b/luxc/src/lux/compiler/jvm/proc/common.clj
@@ -684,9 +684,6 @@
   ^:private compile-math-acos "acos"
   ^:private compile-math-asin "asin"
   ^:private compile-math-atan "atan"
-  ^:private compile-math-cosh "cosh"
-  ^:private compile-math-sinh "sinh"
-  ^:private compile-math-tanh "tanh"
   ^:private compile-math-exp "exp"
   ^:private compile-math-log "log"
   ^:private compile-math-ceil "ceil"
@@ -708,21 +705,9 @@
                     &&/wrap-double)]]
       (return nil)))
 
-  ^:private compile-math-atan2 "atan2"
   ^:private compile-math-pow "pow"
   )
 
-(defn ^:private compile-math-round [compile ?values special-args]
-  (|do [:let [(&/$Cons ?input (&/$Nil)) ?values]
-        ^MethodVisitor *writer* &/get-writer
-        _ (compile ?input)
-        :let [_ (doto *writer*
-                  &&/unwrap-double
-                  (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Math" "round" "(D)J")
-                  (.visitInsn Opcodes/L2D)
-                  &&/wrap-double)]]
-    (return nil)))
-
 (defn ^:private compile-atom-new [compile ?values special-args]
   (|do [:let [(&/$Cons ?init (&/$Nil)) ?values]
         ^MethodVisitor *writer* &/get-writer
@@ -954,15 +939,10 @@
       "acos" (compile-math-acos compile ?values special-args)
       "asin" (compile-math-asin compile ?values special-args)
       "atan" (compile-math-atan compile ?values special-args)
-      "cosh" (compile-math-cosh compile ?values special-args)
-      "sinh" (compile-math-sinh compile ?values special-args)
-      "tanh" (compile-math-tanh compile ?values special-args)
       "exp" (compile-math-exp compile ?values special-args)
       "log" (compile-math-log compile ?values special-args)
       "ceil" (compile-math-ceil compile ?values special-args)
       "floor" (compile-math-floor compile ?values special-args)
-      "round" (compile-math-round compile ?values special-args)
-      "atan2" (compile-math-atan2 compile ?values special-args)
       "pow" (compile-math-pow compile ?values special-args)
       )
 
diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux
index 4d65c75b8..64ee13480 100644
--- a/stdlib/source/lux/math.lux
+++ b/stdlib/source/lux/math.lux
@@ -2,8 +2,9 @@
   lux
   (lux (control monad
                 ["p" parser "p/" Functor<Parser>])
-       (data (coll [list "L/" Fold<List>])
-             [product])
+       (data [product]
+             [number]
+             (coll [list "L/" Fold<List>]))
        [macro]
        (macro ["s" syntax #+ syntax: Syntax]
               [code])))
@@ -33,26 +34,49 @@
   [asin  "lux math asin"]
   [atan  "lux math atan"]
   
-  [cosh  "lux math cosh"]
-  [sinh  "lux math sinh"]
-  [tanh  "lux math tanh"]
-
   [exp   "lux math exp"]
   [log   "lux math log"]
   
   [ceil  "lux math ceil"]
   [floor "lux math floor"]
-  [round "lux math round"]
   )
 
-(do-template [<name> <method>]
-  [(def: #export (<name> param subject)
-     (-> Frac Frac Frac)
-     (<method> subject param))]
+(def: #export (round input)
+  (-> Frac Frac)
+  (let [floored (floor input)
+        diff (f/- floored input)]
+    (cond (f/> 0.5 diff)
+          (f/+ 1.0 floored)
+          
+          (f/< -0.5 diff)
+          (f/+ -1.0 floored)
+          
+          ## else
+          floored)))
 
-  [atan2 "lux math atan2"]
-  [pow   "lux math pow"]
-  )
+(def: #export (pow param subject)
+  (-> Frac Frac Frac)
+  ("lux math pow" subject param))
+
+(def: #export (atan2 param subject)
+  (-> Frac Frac Frac)
+  (cond (f/> 0.0 param)
+        (atan (f// param subject))
+
+        (f/< 0.0 param)
+        (if (f/>= 0.0 subject)
+          (|> subject (f// param) atan (f/+ pi))
+          (|> subject (f// param) atan (f/- pi)))
+
+        ## (f/= 0.0 param)
+        (cond (f/> 0.0 subject)
+              (|> pi (f// 2.0))
+              
+              (f/< 0.0 subject)
+              (|> pi (f// -2.0))
+              
+              ## (f/= 0.0 subject)
+              number.not-a-number)))
 
 (def: #export (log' base input)
   (-> Frac Frac Frac)
@@ -95,6 +119,65 @@
   [Int i/mod i/gcd i/lcm  0 i/* i// i/-]
   )
 
+## Hyperbolic functions
+## https://en.wikipedia.org/wiki/Hyperbolic_function#Definitions
+(do-template [<name> <comp> <inverse>]
+  [(def: #export (<name> x)
+     (-> Frac Frac)
+     (|> (exp x) (<comp> (exp (f/* -1.0 x))) (f// 2.0)))
+
+   (def: #export (<inverse> x)
+     (-> Frac Frac)
+     (|> 2.0 (f// (|> (exp x) (<comp> (exp (f/* -1.0 x)))))))]
+
+  [sinh f/- csch]
+  [cosh f/+ sech]
+  )
+
+(do-template [<name> <top> <bottom>]
+  [(def: #export (<name> x)
+     (-> Frac Frac)
+     (let [e+ (exp x)
+           e- (exp (f/* -1.0 x))
+           sinh' (|> e+ (f/- e-))
+           cosh' (|> e+ (f/+ e-))]
+       (|> <top> (f// <bottom>))))]
+
+  [tanh sinh' cosh']
+  [coth cosh' sinh']
+  )
+
+## https://en.wikipedia.org/wiki/Inverse_hyperbolic_functions#Definitions_in_terms_of_logarithms
+(do-template [<name> <comp>]
+  [(def: #export (<name> x)
+     (-> Frac Frac)
+     (|> x (pow 2.0) (<comp> 1.0) (pow 0.5) (f/+ x) log))]
+
+  [asinh f/+]
+  [acosh f/-]
+  )
+
+(do-template [<name> <base> <diff>]
+  [(def: #export (<name> x)
+     (-> Frac Frac)
+     (let [x+ (|> <base> (f/+ <diff>))
+           x- (|> <base> (f/- <diff>))]
+       (|> x+ (f// x-) log (f// 2.0))))]
+
+  [atanh 1.0 x]
+  [acoth x 1.0]
+  )
+
+(do-template [<name> <op>]
+  [(def: #export (<name> x)
+     (-> Frac Frac)
+     (let [x^2 (|> x (pow 2.0))]
+       (|> 1.0 (<op> x^2) (pow 0.5) (f/+ 1.0) (f// x) log)))]
+
+  [asech f/-]
+  [acsch f/+]
+  )
+
 ## [Syntax]
 (type: #rec Infix
   (#Const Code)