diff options
Diffstat (limited to '')
20 files changed, 123 insertions, 723 deletions
diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj index 7b6bc6a3f..ee9ea33e8 100644 --- a/luxc/src/lux/analyser/proc/common.clj +++ b/luxc/src/lux/analyser/proc/common.clj @@ -287,40 +287,6 @@ (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["array" "size"]) (&/|list =array) (&/|list))))))))) -(do-template [<name> <proc>] - (defn <name> [analyse exo-type ?values] - (|do [:let [(&/$Cons ?input (&/$Nil)) ?values] - =input (&&/analyse-1 analyse &type/Frac ?input) - _ (&type/check exo-type &type/Frac) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor - (&&/$proc (&/T ["math" <proc>]) (&/|list =input) (&/|list))))))) - - ^:private analyse-math-cos "cos" - ^:private analyse-math-sin "sin" - ^:private analyse-math-tan "tan" - ^:private analyse-math-acos "acos" - ^:private analyse-math-asin "asin" - ^:private analyse-math-atan "atan" - ^:private analyse-math-exp "exp" - ^:private analyse-math-log "log" - ^:private analyse-math-ceil "ceil" - ^:private analyse-math-floor "floor" - ) - -(do-template [<name> <proc>] - (defn <name> [analyse exo-type ?values] - (|do [:let [(&/$Cons ?input (&/$Cons ?param (&/$Nil))) ?values] - =input (&&/analyse-1 analyse &type/Frac ?input) - =param (&&/analyse-1 analyse &type/Frac ?param) - _ (&type/check exo-type &type/Frac) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor - (&&/$proc (&/T ["math" <proc>]) (&/|list =input =param) (&/|list))))))) - - ^:private analyse-math-pow "pow" - ) - (defn ^:private analyse-atom-new [analyse exo-type ?values] (&type/with-var (fn [$var] @@ -463,18 +429,6 @@ "lux frac max" (analyse-frac-max analyse exo-type ?values) "lux frac int" (analyse-frac-int analyse exo-type ?values) - "lux math cos" (analyse-math-cos analyse exo-type ?values) - "lux math sin" (analyse-math-sin analyse exo-type ?values) - "lux math tan" (analyse-math-tan analyse exo-type ?values) - "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 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 pow" (analyse-math-pow analyse exo-type ?values) - "lux atom new" (analyse-atom-new analyse exo-type ?values) "lux atom read" (analyse-atom-read analyse exo-type ?values) "lux atom compare-and-swap" (analyse-atom-compare-and-swap analyse exo-type ?values) diff --git a/luxc/src/lux/compiler/jvm/proc/common.clj b/luxc/src/lux/compiler/jvm/proc/common.clj index 3b490ebb6..b074e37b9 100644 --- a/luxc/src/lux/compiler/jvm/proc/common.clj +++ b/luxc/src/lux/compiler/jvm/proc/common.clj @@ -464,47 +464,6 @@ &&/wrap-long)]] (return nil))) -(do-template [<name> <method>] - (defn <name> [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" <method> "(D)D") - &&/wrap-double)]] - (return nil))) - - ^:private compile-math-cos "cos" - ^:private compile-math-sin "sin" - ^:private compile-math-tan "tan" - ^:private compile-math-acos "acos" - ^:private compile-math-asin "asin" - ^:private compile-math-atan "atan" - ^:private compile-math-exp "exp" - ^:private compile-math-log "log" - ^:private compile-math-ceil "ceil" - ^:private compile-math-floor "floor" - ) - -(do-template [<name> <method>] - (defn <name> [compile ?values special-args] - (|do [:let [(&/$Cons ?input (&/$Cons ?param (&/$Nil))) ?values] - ^MethodVisitor *writer* &/get-writer - _ (compile ?input) - :let [_ (doto *writer* - &&/unwrap-double)] - _ (compile ?param) - :let [_ (doto *writer* - &&/unwrap-double)] - :let [_ (doto *writer* - (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Math" <method> "(DD)D") - &&/wrap-double)]] - (return nil))) - - ^:private compile-math-pow "pow" - ) - (defn ^:private compile-atom-new [compile ?values special-args] (|do [:let [(&/$Cons ?init (&/$Nil)) ?values] ^MethodVisitor *writer* &/get-writer @@ -675,21 +634,6 @@ "decode" (compile-frac-decode compile ?values special-args) ) - "math" - (case proc - "cos" (compile-math-cos compile ?values special-args) - "sin" (compile-math-sin compile ?values special-args) - "tan" (compile-math-tan compile ?values special-args) - "acos" (compile-math-acos compile ?values special-args) - "asin" (compile-math-asin compile ?values special-args) - "atan" (compile-math-atan 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) - "pow" (compile-math-pow compile ?values special-args) - ) - "box" (case proc "new" (compile-box-new compile ?values special-args) diff --git a/new-luxc/source/luxc/lang/translation/common-lisp/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/common-lisp/procedure/common.jvm.lux index ba2e0a8b4..7218d9618 100644 --- a/new-luxc/source/luxc/lang/translation/common-lisp/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/common-lisp/procedure/common.jvm.lux @@ -315,32 +315,6 @@ (install "clip" (trinary text//clip)) ))) -## [[Math]] -(def: (math//pow [subject param]) - Binary - ((_.$apply2 (_.global "expt")) subject param)) - -(def: math-func - (-> Text (-> Expression Expression)) - (|>> _.global _.$apply1)) - -(def: math-procs - Bundle - (<| (prefix "math") - (|> (dict.new text.Hash<Text>) - (install "cos" (unary (math-func "cos"))) - (install "sin" (unary (math-func "sin"))) - (install "tan" (unary (math-func "tan"))) - (install "acos" (unary (math-func "acos"))) - (install "asin" (unary (math-func "asin"))) - (install "atan" (unary (math-func "atan"))) - (install "exp" (unary (math-func "exp"))) - (install "log" (unary (math-func "log"))) - (install "ceil" (unary (math-func "ceiling"))) - (install "floor" (unary (math-func "floor"))) - (install "pow" (binary math//pow)) - ))) - ## [[IO]] (def: (void code) (-> Expression Expression) @@ -415,7 +389,6 @@ (dict.merge frac-procs) (dict.merge text-procs) (dict.merge array-procs) - (dict.merge math-procs) (dict.merge io-procs) (dict.merge atom-procs) (dict.merge box-procs) diff --git a/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux index 4c3b0afe8..b40f00c73 100644 --- a/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux @@ -284,37 +284,6 @@ ) -## [[Math]] -(do-template [<name> <method>] - [(def: (<name> inputJS) - Unary - (format "Math." <method> "(" inputJS ")"))] - - [math//cos "cos"] - [math//sin "sin"] - [math//tan "tan"] - [math//acos "acos"] - [math//asin "asin"] - [math//atan "atan"] - [math//cosh "cosh"] - [math//sinh "sinh"] - [math//tanh "tanh"] - [math//exp "exp"] - [math//log "log"] - [math//ceil "ceil"] - [math//floor "floor"] - [math//round "round"] - ) - -(do-template [<name> <method>] - [(def: (<name> [inputJS paramJS]) - Binary - (format "Math." <method> "(" inputJS "," paramJS ")"))] - - [math//atan2 "atan2"] - [math//pow "pow"] - ) - ## [[IO]] (def: (io//log messageJS) Unary @@ -454,28 +423,6 @@ (install "size" (unary array//size)) ))) -(def: math-procs - Bundle - (<| (prefix "math") - (|> (dict.new text.Hash<Text>) - (install "cos" (unary math//cos)) - (install "sin" (unary math//sin)) - (install "tan" (unary math//tan)) - (install "acos" (unary math//acos)) - (install "asin" (unary math//asin)) - (install "atan" (unary math//atan)) - (install "cosh" (unary math//cosh)) - (install "sinh" (unary math//sinh)) - (install "tanh" (unary math//tanh)) - (install "exp" (unary math//exp)) - (install "log" (unary math//log)) - (install "ceil" (unary math//ceil)) - (install "floor" (unary math//floor)) - (install "round" (unary math//round)) - (install "atan2" (binary math//atan2)) - (install "pow" (binary math//pow)) - ))) - (def: io-procs Bundle (<| (prefix "io") @@ -518,7 +465,6 @@ (dict.merge frac-procs) (dict.merge text-procs) (dict.merge array-procs) - (dict.merge math-procs) (dict.merge io-procs) (dict.merge atom-procs) (dict.merge box-procs) diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux index 2334f9cc2..327a95871 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux @@ -378,53 +378,6 @@ runtimeT.noneI (_.label @end)))) -## [[Math]] -(def: math-unary-method ($t.method (list $t.double) (#.Some $t.double) (list))) -(def: math-binary-method ($t.method (list $t.double $t.double) (#.Some $t.double) (list))) - -(do-template [<name> <method>] - [(def: (<name> inputI) - Unary - (|>> inputI - (_.unwrap #$.Double) - (_.INVOKESTATIC "java.lang.Math" <method> math-unary-method #0) - (_.wrap #$.Double)))] - - [math//cos "cos"] - [math//sin "sin"] - [math//tan "tan"] - [math//acos "acos"] - [math//asin "asin"] - [math//atan "atan"] - [math//cosh "cosh"] - [math//sinh "sinh"] - [math//tanh "tanh"] - [math//exp "exp"] - [math//log "log"] - [math//ceil "ceil"] - [math//floor "floor"] - ) - -(do-template [<name> <method>] - [(def: (<name> [inputI paramI]) - Binary - (|>> inputI (_.unwrap #$.Double) - paramI (_.unwrap #$.Double) - (_.INVOKESTATIC "java.lang.Math" <method> math-binary-method #0) - (_.wrap #$.Double)))] - - [math//atan2 "atan2"] - [math//pow "pow"] - ) - -(def: (math//round inputI) - Unary - (|>> inputI - (_.unwrap #$.Double) - (_.INVOKESTATIC "java.lang.Math" "round" ($t.method (list $t.double) (#.Some $t.long) (list)) #0) - _.L2D - (_.wrap #$.Double))) - ## [[IO]] (def: string-method $.Method ($t.method (list $String) #.None (list))) (def: (io//log messageI) @@ -597,28 +550,6 @@ (install "size" (unary array//size)) ))) -(def: math-procs - Bundle - (<| (prefix "math") - (|> (dict.new text.Hash<Text>) - (install "cos" (unary math//cos)) - (install "sin" (unary math//sin)) - (install "tan" (unary math//tan)) - (install "acos" (unary math//acos)) - (install "asin" (unary math//asin)) - (install "atan" (unary math//atan)) - (install "cosh" (unary math//cosh)) - (install "sinh" (unary math//sinh)) - (install "tanh" (unary math//tanh)) - (install "exp" (unary math//exp)) - (install "log" (unary math//log)) - (install "ceil" (unary math//ceil)) - (install "floor" (unary math//floor)) - (install "round" (unary math//round)) - (install "atan2" (binary math//atan2)) - (install "pow" (binary math//pow)) - ))) - (def: io-procs Bundle (<| (prefix "io") @@ -661,7 +592,6 @@ (dict.merge frac-procs) (dict.merge text-procs) (dict.merge array-procs) - (dict.merge math-procs) (dict.merge io-procs) (dict.merge atom-procs) (dict.merge box-procs) diff --git a/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux index cfbe7f0ac..372d107cb 100644 --- a/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux @@ -287,28 +287,6 @@ [text//index runtimeT.text//index] ) -## [[Math]] -(do-template [<name> <method>] - [(def: (<name> inputO) - Unary - (lua.apply <method> (list inputO)))] - - [math//cos "math.cos"] - [math//sin "math.sin"] - [math//tan "math.tan"] - [math//acos "math.acos"] - [math//asin "math.asin"] - [math//atan "math.atan"] - [math//exp "math.exp"] - [math//log "math.log"] - [math//ceil "math.ceil"] - [math//floor "math.floor"] - ) - -(def: (math//pow [inputO paramO]) - Binary - (lua.apply "math.pow" (list inputO paramO))) - ## [[IO]] (def: (io//log messageO) Unary @@ -442,23 +420,6 @@ (install "size" (unary array//size)) ))) -(def: math-procs - Bundle - (<| (prefix "math") - (|> (dict.new text.Hash<Text>) - (install "cos" (unary math//cos)) - (install "sin" (unary math//sin)) - (install "tan" (unary math//tan)) - (install "acos" (unary math//acos)) - (install "asin" (unary math//asin)) - (install "atan" (unary math//atan)) - (install "exp" (unary math//exp)) - (install "log" (unary math//log)) - (install "ceil" (unary math//ceil)) - (install "floor" (unary math//floor)) - (install "pow" (binary math//pow)) - ))) - (def: io-procs Bundle (<| (prefix "io") @@ -501,7 +462,6 @@ (dict.merge frac-procs) (dict.merge text-procs) (dict.merge array-procs) - (dict.merge math-procs) (dict.merge io-procs) (dict.merge atom-procs) (dict.merge box-procs) diff --git a/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux index 9638ec9bf..715d8bf0b 100644 --- a/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux @@ -327,28 +327,6 @@ ## (install "clip" (trinary text//clip)) ## ))) -## ## [[Math]] -## (def: (math//pow [subject param]) -## Binary -## (|> subject (_.** param))) - -## (def: math-procs -## Bundle -## (<| (prefix "math") -## (|> (dict.new text.Hash<Text>) -## (install "cos" (unary runtimeT.math//cos)) -## (install "sin" (unary runtimeT.math//sin)) -## (install "tan" (unary runtimeT.math//tan)) -## (install "acos" (unary runtimeT.math//acos)) -## (install "asin" (unary runtimeT.math//asin)) -## (install "atan" (unary runtimeT.math//atan)) -## (install "exp" (unary runtimeT.math//exp)) -## (install "log" (unary runtimeT.math//log)) -## (install "ceil" (unary runtimeT.math//ceil)) -## (install "floor" (unary runtimeT.math//floor)) -## (install "pow" (binary math//pow)) -## ))) - ## ## [[IO]] ## (def: io-procs ## Bundle @@ -409,7 +387,6 @@ ## (dict.merge frac-procs) ## (dict.merge text-procs) ## (dict.merge array-procs) - ## (dict.merge math-procs) ## (dict.merge io-procs) ## (dict.merge atom-procs) ## (dict.merge process-procs) diff --git a/new-luxc/source/luxc/lang/translation/php/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/php/runtime.jvm.lux index ac04df255..d4c14b473 100644 --- a/new-luxc/source/luxc/lang/translation/php/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/php/runtime.jvm.lux @@ -338,38 +338,6 @@ ## @@process//future ## @@process//schedule)) -## (do-template [<name> <method>] -## [(runtime: (<name> input) -## ($_ _.then! -## (_.import! "math") -## (_.return! (|> (_.global "math") (_.send (list input) <method>)))))] - -## [math//cos "cos"] -## [math//sin "sin"] -## [math//tan "tan"] -## [math//acos "acos"] -## [math//asin "asin"] -## [math//atan "atan"] -## [math//exp "exp"] -## [math//log "log"] -## [math//ceil "ceil"] -## [math//floor "floor"] -## ) - -## (def: runtime//math -## Runtime -## ($_ _.then! -## @@math//cos -## @@math//sin -## @@math//tan -## @@math//acos -## @@math//asin -## @@math//atan -## @@math//exp -## @@math//log -## @@math//ceil -## @@math//floor)) - (def: check-necessary-conditions! Statement (let [condition (_.= (_.int 8) @@ -391,7 +359,6 @@ ## runtime//atom ## runtime//io ## runtime//process - ## runtime//math )) (def: #export artifact Text (format prefix //.extension)) diff --git a/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux index f7cdf044a..35ffdb1f8 100644 --- a/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux @@ -347,28 +347,6 @@ (install "clip" (trinary text//clip)) ))) -## [[Math]] -(def: (math//pow [subject param]) - Binary - (|> subject (python.** param))) - -(def: math-procs - Bundle - (<| (prefix "math") - (|> (dict.new text.Hash<Text>) - (install "cos" (unary runtimeT.math//cos)) - (install "sin" (unary runtimeT.math//sin)) - (install "tan" (unary runtimeT.math//tan)) - (install "acos" (unary runtimeT.math//acos)) - (install "asin" (unary runtimeT.math//asin)) - (install "atan" (unary runtimeT.math//atan)) - (install "exp" (unary runtimeT.math//exp)) - (install "log" (unary runtimeT.math//log)) - (install "ceil" (unary runtimeT.math//ceil)) - (install "floor" (unary runtimeT.math//floor)) - (install "pow" (binary math//pow)) - ))) - ## [[IO]] (def: io-procs Bundle @@ -449,7 +427,6 @@ (dict.merge frac-procs) (dict.merge text-procs) (dict.merge array-procs) - (dict.merge math-procs) (dict.merge io-procs) (dict.merge atom-procs) (dict.merge box-procs) diff --git a/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux index 275eea636..3dd5980e8 100644 --- a/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux @@ -375,38 +375,6 @@ Runtime @@process//schedule) -(do-template [<name> <method>] - [(runtime: (<name> input) - ($_ python.then! - (python.import! "math") - (python.return! (|> (python.global "math") (python.send (list input) <method>)))))] - - [math//cos "cos"] - [math//sin "sin"] - [math//tan "tan"] - [math//acos "acos"] - [math//asin "asin"] - [math//atan "atan"] - [math//exp "exp"] - [math//log "log"] - [math//ceil "ceil"] - [math//floor "floor"] - ) - -(def: runtime//math - Runtime - ($_ python.then! - @@math//cos - @@math//sin - @@math//tan - @@math//acos - @@math//asin - @@math//atan - @@math//exp - @@math//log - @@math//ceil - @@math//floor)) - (def: runtime Runtime ($_ python.then! @@ -420,7 +388,6 @@ runtime//box runtime//io runtime//process - runtime//math )) (def: #export artifact Text (format prefix ".py")) diff --git a/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux index eab139f33..c17eb6738 100644 --- a/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux @@ -329,33 +329,6 @@ (install "clip" (trinary text//clip)) ))) -## [[Math]] -(def: (math//pow [subject param]) - Binary - (|> subject (r.** param))) - -(def: (math-func name) - (-> Text (-> Expression Expression)) - (function (_ input) - (r.apply (list input) (r.global name)))) - -(def: math-procs - Bundle - (<| (prefix "math") - (|> (dict.new text.Hash<Text>) - (install "cos" (unary (math-func "cos"))) - (install "sin" (unary (math-func "sin"))) - (install "tan" (unary (math-func "tan"))) - (install "acos" (unary (math-func "acos"))) - (install "asin" (unary (math-func "asin"))) - (install "atan" (unary (math-func "atan"))) - (install "exp" (unary (math-func "exp"))) - (install "log" (unary (math-func "log"))) - (install "ceil" (unary (math-func "ceiling"))) - (install "floor" (unary (math-func "floor"))) - (install "pow" (binary math//pow)) - ))) - ## [[IO]] (def: (io//exit input) Unary @@ -446,7 +419,6 @@ (dict.merge frac-procs) (dict.merge text-procs) (dict.merge array-procs) - (dict.merge math-procs) (dict.merge io-procs) (dict.merge atom-procs) (dict.merge box-procs) diff --git a/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux index bed68a0a0..ba6a1241a 100644 --- a/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux @@ -360,52 +360,6 @@ (install "clip" (trinary text//clip)) ))) -## [[Math]] -(do-template [<name> <method>] - [(def: <name> - Unary - (|>> (list) (ruby.apply <method>)))] - - [math//cos "Math.cos"] - [math//sin "Math.sin"] - [math//tan "Math.tan"] - [math//acos "Math.acos"] - [math//asin "Math.asin"] - [math//atan "Math.atan"] - [math//exp "Math.exp"] - [math//log "Math.log"] - ) - -(do-template [<name> <method>] - [(def: <name> - Unary - (ruby.send <method> (list)))] - - [math//ceil "ceil"] - [math//floor "floor"] - ) - -(def: (math//pow [inputO paramO]) - Binary - (ruby.pow paramO inputO)) - -(def: math-procs - Bundle - (<| (prefix "math") - (|> (dict.new text.Hash<Text>) - (install "cos" (unary math//cos)) - (install "sin" (unary math//sin)) - (install "tan" (unary math//tan)) - (install "acos" (unary math//acos)) - (install "asin" (unary math//asin)) - (install "atan" (unary math//atan)) - (install "exp" (unary math//exp)) - (install "log" (unary math//log)) - (install "ceil" (unary math//ceil)) - (install "floor" (unary math//floor)) - (install "pow" (binary math//pow)) - ))) - ## [[IO]] (def: (io//log messageO) Unary @@ -506,7 +460,6 @@ (dict.merge frac-procs) (dict.merge text-procs) (dict.merge array-procs) - (dict.merge math-procs) (dict.merge io-procs) (dict.merge atom-procs) (dict.merge box-procs) diff --git a/new-luxc/test/test/luxc/lang/translation/common.lux b/new-luxc/test/test/luxc/lang/translation/common.lux index 2641d8acd..9a2465ce3 100644 --- a/new-luxc/test/test/luxc/lang/translation/common.lux +++ b/new-luxc/test/test/luxc/lang/translation/common.lux @@ -327,46 +327,6 @@ #0))) ))) -(def: (math-spec run) - (-> Runner Test) - (do r.Monad<Random> - [subject r.frac - param r.frac] - (`` ($_ seq - (~~ (do-template [<name>] - [(test (format "Can apply '" <name> "' procedure.") - (|> (run (#synthesis.Extension <name> (list (synthesis.f64 subject)))) - (case> (#e.Success valueV) - #1 - - (#e.Error error) - (exec (log! error) - #0))))] - - ["lux math cos"] - ["lux math sin"] - ["lux math tan"] - ["lux math acos"] - ["lux math asin"] - ["lux math atan"] - ["lux math exp"] - ["lux math log"] - ["lux math ceil"] - ["lux math floor"])) - (~~ (do-template [<name>] - [(test (format "Can apply '" <name> "' procedure.") - (|> (run (#synthesis.Extension <name> (list (synthesis.f64 subject) - (synthesis.f64 param)))) - (case> (#e.Success valueV) - #1 - - (#e.Error error) - (exec (log! error) - #0))))] - - ["lux math pow"])) - )))) - (def: (io-spec run) (-> Runner Test) (do r.Monad<Random> @@ -552,7 +512,6 @@ (f64-spec run) (text-spec run) (array-spec run) - (math-spec run) (io-spec run) (atom-spec run) (box-spec run) diff --git a/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux b/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux index d4e94a36f..437a54bbc 100644 --- a/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux +++ b/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux @@ -240,28 +240,6 @@ (bundle.install "size" (unary (type (Ex [a] (Array a))) Nat)) ))) -(def: bundle::math - Bundle - (<| (bundle.prefix "math") - (|> bundle.empty - (bundle.install "cos" (unary Frac Frac)) - (bundle.install "sin" (unary Frac Frac)) - (bundle.install "tan" (unary Frac Frac)) - (bundle.install "acos" (unary Frac Frac)) - (bundle.install "asin" (unary Frac Frac)) - (bundle.install "atan" (unary Frac Frac)) - (bundle.install "cosh" (unary Frac Frac)) - (bundle.install "sinh" (unary Frac Frac)) - (bundle.install "tanh" (unary Frac Frac)) - (bundle.install "exp" (unary Frac Frac)) - (bundle.install "log" (unary Frac Frac)) - (bundle.install "ceil" (unary Frac Frac)) - (bundle.install "floor" (unary Frac Frac)) - (bundle.install "round" (unary Frac Frac)) - (bundle.install "atan2" (binary Frac Frac Frac)) - (bundle.install "pow" (binary Frac Frac Frac)) - ))) - (def: atom::new Handler (function (_ extension-name analyse args) @@ -362,7 +340,6 @@ (dict.merge bundle::frac) (dict.merge bundle::text) (dict.merge bundle::array) - (dict.merge bundle::math) (dict.merge bundle::atom) (dict.merge bundle::box) (dict.merge bundle::process) diff --git a/stdlib/source/lux/compiler/default/phase/translation/scheme/extension/common.jvm.lux b/stdlib/source/lux/compiler/default/phase/translation/scheme/extension/common.jvm.lux index 9952a754d..a508dfabd 100644 --- a/stdlib/source/lux/compiler/default/phase/translation/scheme/extension/common.jvm.lux +++ b/stdlib/source/lux/compiler/default/phase/translation/scheme/extension/common.jvm.lux @@ -250,32 +250,6 @@ (bundle.install "char" (binary text::char)) (bundle.install "clip" (trinary text::clip))))) -## [[Math]] -(def: (math::pow [subject param]) - Binary - (_.expt/2 param subject)) - -(def: math-func - (-> Text Unary) - (|>> _.global _.apply/1)) - -(def: bundle::math - Bundle - (<| (bundle.prefix "math") - (|> bundle.empty - (bundle.install "cos" (unary (math-func "cos"))) - (bundle.install "sin" (unary (math-func "sin"))) - (bundle.install "tan" (unary (math-func "tan"))) - (bundle.install "acos" (unary (math-func "acos"))) - (bundle.install "asin" (unary (math-func "asin"))) - (bundle.install "atan" (unary (math-func "atan"))) - (bundle.install "exp" (unary (math-func "exp"))) - (bundle.install "log" (unary (math-func "log"))) - (bundle.install "ceil" (unary (math-func "ceiling"))) - (bundle.install "floor" (unary (math-func "floor"))) - (bundle.install "pow" (binary math::pow)) - ))) - ## [[IO]] (def: (io::log input) Unary @@ -352,7 +326,6 @@ (dict.merge bundle::frac) (dict.merge bundle::text) (dict.merge bundle::array) - (dict.merge bundle::math) (dict.merge bundle::io) (dict.merge bundle::atom) (dict.merge bundle::box) diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index 13ffe71da..583a03b1f 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -12,7 +12,8 @@ [data ["." error (#+ Error)] ["." maybe] - ["." text]]] + ["." text]] + ["." math]] [/ ["." i64]]) @@ -142,8 +143,8 @@ Frac (f// +0.0 <numerator>))] - [not-a-number +0.0 "Not a number."] - [positive-infinity +1.0 "Positive infinity."] + [not-a-number +0.0 "Not a number."] + [positive-infinity +1.0 "Positive infinity."] [negative-infinity -1.0 "Negative infinity."] ) @@ -923,8 +924,8 @@ (def: (log2 input) (-> Frac Frac) - (f// ("lux math log" +2.0) - ("lux math log" input))) + (f// (math.log +2.0) + (math.log input))) (def: double-bias Nat 1023) @@ -953,13 +954,13 @@ ## else (let [sign (:: Number<Frac> signum input) input (:: Number<Frac> abs input) - exponent ("lux math floor" (log2 input)) + exponent (math.floor (log2 input)) exponent-mask (|> 1 (i64.left-shift exponent-size) dec) mantissa (|> input ## Normalize - (f// ("lux math pow" +2.0 exponent)) + (f// (math.pow exponent +2.0)) ## Make it int-equivalent - (f/* ("lux math pow" +2.0 +52.0))) + (f/* (math.pow +52.0 +2.0))) sign-bit (if (f/= -1.0 sign) 1 0) exponent-bits (|> exponent frac-to-int .nat (n/+ double-bias) (i64.and exponent-mask)) mantissa-bits (|> mantissa frac-to-int .nat)] @@ -1000,10 +1001,10 @@ ## else (let [normalized (|> M (i64.set mantissa-size) .int int-to-frac - (f// ("lux math pow" +2.0 +52.0))) - power (|> E (n/- double-bias) - .int int-to-frac - ("lux math pow" +2.0)) + (f// (math.pow +52.0 +2.0))) + power (math.pow (|> E (n/- double-bias) + .int int-to-frac) + +2.0) shifted (f/* power normalized)] (if (n/= 0 S) diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux index cdaf54461..d4650426f 100644 --- a/stdlib/source/lux/math.lux +++ b/stdlib/source/lux/math.lux @@ -1,16 +1,5 @@ (.module: {#.doc "Common mathematical constants and functions."} - [lux #* - [control - monad - ["p" parser ("parser/." Functor<Parser>)]] - [data - ["." product] - ["." number] - [collection - [list ("list/." Fold<List>)]]] - ["." macro - ["s" syntax (#+ syntax: Syntax)] - ["." code]]]) + [lux #*]) ## [Values] (do-template [<name> <value> <doc>] @@ -29,19 +18,19 @@ (-> Frac Frac) (<method> input))] - [cos "lux math cos"] - [sin "lux math sin"] - [tan "lux math tan"] + [cos "jvm invokestatic:java.lang.Math:cos:double"] + [sin "jvm invokestatic:java.lang.Math:sin:double"] + [tan "jvm invokestatic:java.lang.Math:tan:double"] - [acos "lux math acos"] - [asin "lux math asin"] - [atan "lux math atan"] + [acos "jvm invokestatic:java.lang.Math:acos:double"] + [asin "jvm invokestatic:java.lang.Math:asin:double"] + [atan "jvm invokestatic:java.lang.Math:atan:double"] - [exp "lux math exp"] - [log "lux math log"] + [exp "jvm invokestatic:java.lang.Math:exp:double"] + [log "jvm invokestatic:java.lang.Math:log:double"] - [ceil "lux math ceil"] - [floor "lux math floor"] + [ceil "jvm invokestatic:java.lang.Math:ceil:double"] + [floor "jvm invokestatic:java.lang.Math:floor:double"] ) (def: #export (round input) @@ -59,7 +48,7 @@ (def: #export (pow param subject) (-> Frac Frac Frac) - ("lux math pow" subject param)) + ("jvm invokestatic:java.lang.Math:pow:double,double" subject param)) (def: #export (atan2 param subject) (-> Frac Frac Frac) @@ -79,7 +68,7 @@ (|> pi (f// -2.0)) ## (f/= +0.0 subject) - number.not-a-number))) + (f// +0.0 +0.0)))) (def: #export (log' base input) (-> Frac Frac Frac) @@ -180,81 +169,3 @@ [asech f/-] [acsch f/+] ) - -## [Syntax] -(type: #rec Infix - (#Const Code) - (#Call (List Code)) - (#Unary Code Infix) - (#Binary Infix Code Infix)) - -(def: infix^ - (Syntax Infix) - (<| p.rec (function (_ infix^)) - ($_ p.or - ($_ p.either - (parser/map code.bit s.bit) - (parser/map code.nat s.nat) - (parser/map code.int s.int) - (parser/map code.rev s.rev) - (parser/map code.frac s.frac) - (parser/map code.text s.text) - (parser/map code.identifier s.identifier) - (parser/map code.tag s.tag)) - (s.form (p.many s.any)) - (s.tuple (p.and s.any infix^)) - (s.tuple ($_ p.either - (do p.Monad<Parser> - [_ (s.this (' #and)) - init-subject infix^ - init-op s.any - init-param infix^ - steps (p.some (p.and s.any infix^))] - (wrap (product.right (list/fold (function (_ [op param] [subject [_subject _op _param]]) - [param [(#Binary _subject _op _param) - (` and) - (#Binary subject op param)]]) - [init-param [init-subject init-op init-param]] - steps)))) - (do p.Monad<Parser> - [init-subject infix^ - init-op s.any - init-param infix^ - steps (p.some (p.and s.any infix^))] - (wrap (list/fold (function (_ [op param] [_subject _op _param]) - [(#Binary _subject _op _param) op param]) - [init-subject init-op init-param] - steps))) - )) - ))) - -(def: (infix-to-prefix infix) - (-> Infix Code) - (case infix - (#Const value) - value - - (#Call parts) - (code.form parts) - - (#Unary op subject) - (` ((~ op) (~ (infix-to-prefix subject)))) - - (#Binary left op right) - (` ((~ op) (~ (infix-to-prefix right)) (~ (infix-to-prefix left)))) - )) - -(syntax: #export (infix {expr infix^}) - {#.doc (doc "Infix math syntax." - (infix [x i/* +10]) - (infix [[x i/+ y] i/* [x i/- y]]) - (infix [sin [x i/+ y]]) - (infix [[x n/< y] and [y n/< z]]) - (infix [#and x n/< y n/< z]) - (infix [(n/* 3 9) gcd 450]) - - "The rules for infix syntax are simple." - "If you want your binary function to work well with it." - "Then take the argument to the right (y) as your first argument," - "and take the argument to the left (x) as your second argument.")} - (wrap (list (infix-to-prefix expr)))) diff --git a/stdlib/source/lux/math/infix.lux b/stdlib/source/lux/math/infix.lux new file mode 100644 index 000000000..145b8f579 --- /dev/null +++ b/stdlib/source/lux/math/infix.lux @@ -0,0 +1,89 @@ +(.module: {#.doc "Common mathematical constants and functions."} + [lux #* + [control + monad + ["p" parser ("parser/." Functor<Parser>)]] + [data + ["." product] + [collection + [list ("list/." Fold<List>)]]] + [macro + ["s" syntax (#+ syntax: Syntax)] + ["." code]]]) + +(type: #rec Infix + (#Const Code) + (#Call (List Code)) + (#Unary Code Infix) + (#Binary Infix Code Infix)) + +(def: infix^ + (Syntax Infix) + (<| p.rec (function (_ infix^)) + ($_ p.or + ($_ p.either + (parser/map code.bit s.bit) + (parser/map code.nat s.nat) + (parser/map code.int s.int) + (parser/map code.rev s.rev) + (parser/map code.frac s.frac) + (parser/map code.text s.text) + (parser/map code.identifier s.identifier) + (parser/map code.tag s.tag)) + (s.form (p.many s.any)) + (s.tuple (p.and s.any infix^)) + (s.tuple ($_ p.either + (do p.Monad<Parser> + [_ (s.this (' #and)) + init-subject infix^ + init-op s.any + init-param infix^ + steps (p.some (p.and s.any infix^))] + (wrap (product.right (list/fold (function (_ [op param] [subject [_subject _op _param]]) + [param [(#Binary _subject _op _param) + (` and) + (#Binary subject op param)]]) + [init-param [init-subject init-op init-param]] + steps)))) + (do p.Monad<Parser> + [init-subject infix^ + init-op s.any + init-param infix^ + steps (p.some (p.and s.any infix^))] + (wrap (list/fold (function (_ [op param] [_subject _op _param]) + [(#Binary _subject _op _param) op param]) + [init-subject init-op init-param] + steps))) + )) + ))) + +(def: (infix-to-prefix infix) + (-> Infix Code) + (case infix + (#Const value) + value + + (#Call parts) + (code.form parts) + + (#Unary op subject) + (` ((~ op) (~ (infix-to-prefix subject)))) + + (#Binary left op right) + (` ((~ op) (~ (infix-to-prefix right)) (~ (infix-to-prefix left)))) + )) + +(syntax: #export (infix {expr infix^}) + {#.doc (doc "Infix math syntax." + (infix [x i/* +10]) + (infix [[x i/+ y] i/* [x i/- y]]) + (infix [sin [x i/+ y]]) + (infix [[x n/< y] and [y n/< z]]) + (infix [#and x n/< y n/< z]) + (infix [(n/* 3 9) gcd 450]) + + "The rules for infix syntax are simple." + "If you want your binary function to work well with it." + "Then take the argument to the right (y) as your first argument," + "and take the argument to the left (x) as your second argument.")} + (wrap (list (infix-to-prefix expr)))) diff --git a/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux b/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux index 5fc04278b..8d3e8b8fa 100644 --- a/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux +++ b/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux @@ -207,37 +207,6 @@ (` ("lux array size" (~ g!array))))) )))) -(context: "Math procedures" - (<| (times 100) - (do @ - [subjectC (|> r.frac (:: @ map code.frac)) - paramC (|> r.frac (:: @ map code.frac))] - (`` ($_ seq - (~~ (do-template [<proc> <desc>] - [(test (format "Can calculate " <desc> ".") - (check-success+ <proc> (list subjectC) Frac))] - - ["lux math cos" "cosine"] - ["lux math sin" "sine"] - ["lux math tan" "tangent"] - ["lux math acos" "inverse/arc cosine"] - ["lux math asin" "inverse/arc sine"] - ["lux math atan" "inverse/arc tangent"] - ["lux math cosh" "hyperbolic cosine"] - ["lux math sinh" "hyperbolic sine"] - ["lux math tanh" "hyperbolic tangent"] - ["lux math exp" "exponentiation"] - ["lux math log" "logarithm"] - ["lux math ceil" "ceiling"] - ["lux math floor" "floor"] - ["lux math round" "rounding"])) - (~~ (do-template [<proc> <desc>] - [(test (format "Can calculate " <desc> ".") - (check-success+ <proc> (list subjectC paramC) Frac))] - - ["lux math atan2" "inverse/arc tangent (with 2 arguments)"] - ["lux math pow" "power"]))))))) - (context: "Atom procedures" (<| (times 100) (do @ diff --git a/stdlib/test/test/lux/math.lux b/stdlib/test/test/lux/math.lux index 4cdb8eed5..059f19c4c 100644 --- a/stdlib/test/test/lux/math.lux +++ b/stdlib/test/test/lux/math.lux @@ -6,6 +6,7 @@ [bit ("bit/." Equivalence<Bit>)] [number ("frac/." Number<Frac>)]] ["&" math + infix ["r" random]]] lux/test) @@ -98,27 +99,27 @@ ($_ seq (test "Constant values don't change." (n/= x - (&.infix x))) + (infix x))) (test "Can call binary functions." (n/= (&.n/gcd y x) - (&.infix [x &.n/gcd y]))) + (infix [x &.n/gcd y]))) (test "Can call unary functions." (f/= (&.sin theta) - (&.infix [&.sin theta]))) + (infix [&.sin theta]))) (test "Can use regular syntax in the middle of infix code." (n/= (&.n/gcd 450 (n/* 3 9)) - (&.infix [(n/* 3 9) &.n/gcd 450]))) + (infix [(n/* 3 9) &.n/gcd 450]))) (test "Can use non-numerical functions/macros as operators." (bit/= (and (n/< y x) (n/< z y)) - (&.infix [[x n/< y] and [y n/< z]]))) + (infix [[x n/< y] and [y n/< z]]))) (test "Can combine bit operations in special ways via special keywords." (and (bit/= (and (n/< y x) (n/< z y)) - (&.infix [#and x n/< y n/< z])) + (infix [#and x n/< y n/< z])) (bit/= (and (n/< y x) (n/> z y)) - (&.infix [#and x n/< y n/> z])))) + (infix [#and x n/< y n/> z])))) )))) |