aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2018-04-05 06:02:04 -0400
committerEduardo Julian2018-04-05 06:02:04 -0400
commite2c5e22768c4840842b86b3c0b26a3ad34cacb43 (patch)
treecd4bc1ad7e1268b22fd8aba2937d5f312c8be02d
parent787fc34a8f7c66746046a8ce0c16403cf6c2bf6c (diff)
- Implemented some math functions in pure Lux, to reduce the needs of the compiler, and make it easier to port Lux to new backends.
-rw-r--r--.gitignore1
-rw-r--r--luxc/src/lux/analyser/proc/common.clj10
-rw-r--r--luxc/src/lux/compiler/js/proc/common.clj10
-rw-r--r--luxc/src/lux/compiler/jvm/proc/common.clj20
-rw-r--r--stdlib/source/lux/math.lux111
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)