From e2c5e22768c4840842b86b3c0b26a3ad34cacb43 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Thu, 5 Apr 2018 06:02:04 -0400
Subject: - Implemented some math functions in pure Lux, to reduce the needs of
 the compiler, and make it easier to port Lux to new backends.

---
 stdlib/source/lux/math.lux | 111 +++++++++++++++++++++++++++++++++++++++------
 1 file changed, 97 insertions(+), 14 deletions(-)

(limited to 'stdlib/source')

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)
-- 
cgit v1.2.3