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. --- .gitignore | 1 + luxc/src/lux/analyser/proc/common.clj | 10 --- luxc/src/lux/compiler/js/proc/common.clj | 10 --- luxc/src/lux/compiler/jvm/proc/common.clj | 20 ------ stdlib/source/lux/math.lux | 111 ++++++++++++++++++++++++++---- 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 [ ] @@ -398,7 +394,6 @@ (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["math" ]) (&/|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 [ ] @@ -422,7 +418,6 @@ =param (compile ?param)] (return (str "Math." "(" =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]) - (data (coll [list "L/" Fold]) - [product]) + (data [product] + [number] + (coll [list "L/" Fold])) [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 [ ] - [(def: #export ( param subject) - (-> Frac Frac Frac) - ( 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 [ ] + [(def: #export ( x) + (-> Frac Frac) + (|> (exp x) ( (exp (f/* -1.0 x))) (f// 2.0))) + + (def: #export ( x) + (-> Frac Frac) + (|> 2.0 (f// (|> (exp x) ( (exp (f/* -1.0 x)))))))] + + [sinh f/- csch] + [cosh f/+ sech] + ) + +(do-template [ ] + [(def: #export ( x) + (-> Frac Frac) + (let [e+ (exp x) + e- (exp (f/* -1.0 x)) + sinh' (|> e+ (f/- e-)) + cosh' (|> e+ (f/+ e-))] + (|> (f// ))))] + + [tanh sinh' cosh'] + [coth cosh' sinh'] + ) + +## https://en.wikipedia.org/wiki/Inverse_hyperbolic_functions#Definitions_in_terms_of_logarithms +(do-template [ ] + [(def: #export ( x) + (-> Frac Frac) + (|> x (pow 2.0) ( 1.0) (pow 0.5) (f/+ x) log))] + + [asinh f/+] + [acosh f/-] + ) + +(do-template [ ] + [(def: #export ( x) + (-> Frac Frac) + (let [x+ (|> (f/+ )) + x- (|> (f/- ))] + (|> x+ (f// x-) log (f// 2.0))))] + + [atanh 1.0 x] + [acoth x 1.0] + ) + +(do-template [ ] + [(def: #export ( x) + (-> Frac Frac) + (let [x^2 (|> x (pow 2.0))] + (|> 1.0 ( 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