├── .gitignore ├── CHANGELOG.md ├── LICENSE ├── README.md ├── doc └── intro.md ├── project.clj ├── src └── typeops │ ├── assign.clj │ └── core.clj └── test └── typeops ├── assign_test.clj └── core_test.clj /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /classes 3 | /checkouts 4 | pom.xml 5 | pom.xml.asc 6 | *.jar 7 | *.class 8 | /.lein-* 9 | /.nrepl-port 10 | .hgignore 11 | .hg/ 12 | /.idea 13 | *.iml 14 | /codox 15 | !/.gitignore 16 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Change Log 2 | 3 | ## [0.1.2] - 2019-03-28 4 | ### Changed 5 | - Added/improved `*debug*` and `*warn-on-absent-key*` for error handling and debugging 6 | 7 | ## [0.1.1] - 2017-06-10 8 | ### Changed 9 | - Moved assign operations to a new name space `assign` 10 | - Added `assoc` symbol as an alias for `assign` 11 | - Added `merge` to accompany `assign` 12 | - Improve error handling for unknown types 13 | 14 | ## 0.1.0 - 2017-04-26 15 | ### Initial release 16 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC 2 | LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM 3 | CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 4 | 5 | 1. DEFINITIONS 6 | 7 | "Contribution" means: 8 | 9 | a) in the case of the initial Contributor, the initial code and 10 | documentation distributed under this Agreement, and 11 | 12 | b) in the case of each subsequent Contributor: 13 | 14 | i) changes to the Program, and 15 | 16 | ii) additions to the Program; 17 | 18 | where such changes and/or additions to the Program originate from and are 19 | distributed by that particular Contributor. A Contribution 'originates' from 20 | a Contributor if it was added to the Program by such Contributor itself or 21 | anyone acting on such Contributor's behalf. Contributions do not include 22 | additions to the Program which: (i) are separate modules of software 23 | distributed in conjunction with the Program under their own license 24 | agreement, and (ii) are not derivative works of the Program. 25 | 26 | "Contributor" means any person or entity that distributes the Program. 27 | 28 | "Licensed Patents" mean patent claims licensable by a Contributor which are 29 | necessarily infringed by the use or sale of its Contribution alone or when 30 | combined with the Program. 31 | 32 | "Program" means the Contributions distributed in accordance with this 33 | Agreement. 34 | 35 | "Recipient" means anyone who receives the Program under this Agreement, 36 | including all Contributors. 37 | 38 | 2. GRANT OF RIGHTS 39 | 40 | a) Subject to the terms of this Agreement, each Contributor hereby grants 41 | Recipient a non-exclusive, worldwide, royalty-free copyright license to 42 | reproduce, prepare derivative works of, publicly display, publicly perform, 43 | distribute and sublicense the Contribution of such Contributor, if any, and 44 | such derivative works, in source code and object code form. 45 | 46 | b) Subject to the terms of this Agreement, each Contributor hereby grants 47 | Recipient a non-exclusive, worldwide, royalty-free patent license under 48 | Licensed Patents to make, use, sell, offer to sell, import and otherwise 49 | transfer the Contribution of such Contributor, if any, in source code and 50 | object code form. This patent license shall apply to the combination of the 51 | Contribution and the Program if, at the time the Contribution is added by the 52 | Contributor, such addition of the Contribution causes such combination to be 53 | covered by the Licensed Patents. The patent license shall not apply to any 54 | other combinations which include the Contribution. No hardware per se is 55 | licensed hereunder. 56 | 57 | c) Recipient understands that although each Contributor grants the licenses 58 | to its Contributions set forth herein, no assurances are provided by any 59 | Contributor that the Program does not infringe the patent or other 60 | intellectual property rights of any other entity. Each Contributor disclaims 61 | any liability to Recipient for claims brought by any other entity based on 62 | infringement of intellectual property rights or otherwise. As a condition to 63 | exercising the rights and licenses granted hereunder, each Recipient hereby 64 | assumes sole responsibility to secure any other intellectual property rights 65 | needed, if any. For example, if a third party patent license is required to 66 | allow Recipient to distribute the Program, it is Recipient's responsibility 67 | to acquire that license before distributing the Program. 68 | 69 | d) Each Contributor represents that to its knowledge it has sufficient 70 | copyright rights in its Contribution, if any, to grant the copyright license 71 | set forth in this Agreement. 72 | 73 | 3. REQUIREMENTS 74 | 75 | A Contributor may choose to distribute the Program in object code form under 76 | its own license agreement, provided that: 77 | 78 | a) it complies with the terms and conditions of this Agreement; and 79 | 80 | b) its license agreement: 81 | 82 | i) effectively disclaims on behalf of all Contributors all warranties and 83 | conditions, express and implied, including warranties or conditions of title 84 | and non-infringement, and implied warranties or conditions of merchantability 85 | and fitness for a particular purpose; 86 | 87 | ii) effectively excludes on behalf of all Contributors all liability for 88 | damages, including direct, indirect, special, incidental and consequential 89 | damages, such as lost profits; 90 | 91 | iii) states that any provisions which differ from this Agreement are offered 92 | by that Contributor alone and not by any other party; and 93 | 94 | iv) states that source code for the Program is available from such 95 | Contributor, and informs licensees how to obtain it in a reasonable manner on 96 | or through a medium customarily used for software exchange. 97 | 98 | When the Program is made available in source code form: 99 | 100 | a) it must be made available under this Agreement; and 101 | 102 | b) a copy of this Agreement must be included with each copy of the Program. 103 | 104 | Contributors may not remove or alter any copyright notices contained within 105 | the Program. 106 | 107 | Each Contributor must identify itself as the originator of its Contribution, 108 | if any, in a manner that reasonably allows subsequent Recipients to identify 109 | the originator of the Contribution. 110 | 111 | 4. COMMERCIAL DISTRIBUTION 112 | 113 | Commercial distributors of software may accept certain responsibilities with 114 | respect to end users, business partners and the like. While this license is 115 | intended to facilitate the commercial use of the Program, the Contributor who 116 | includes the Program in a commercial product offering should do so in a 117 | manner which does not create potential liability for other Contributors. 118 | Therefore, if a Contributor includes the Program in a commercial product 119 | offering, such Contributor ("Commercial Contributor") hereby agrees to defend 120 | and indemnify every other Contributor ("Indemnified Contributor") against any 121 | losses, damages and costs (collectively "Losses") arising from claims, 122 | lawsuits and other legal actions brought by a third party against the 123 | Indemnified Contributor to the extent caused by the acts or omissions of such 124 | Commercial Contributor in connection with its distribution of the Program in 125 | a commercial product offering. The obligations in this section do not apply 126 | to any claims or Losses relating to any actual or alleged intellectual 127 | property infringement. In order to qualify, an Indemnified Contributor must: 128 | a) promptly notify the Commercial Contributor in writing of such claim, and 129 | b) allow the Commercial Contributor to control, and cooperate with the 130 | Commercial Contributor in, the defense and any related settlement 131 | negotiations. The Indemnified Contributor may participate in any such claim 132 | at its own expense. 133 | 134 | For example, a Contributor might include the Program in a commercial product 135 | offering, Product X. That Contributor is then a Commercial Contributor. If 136 | that Commercial Contributor then makes performance claims, or offers 137 | warranties related to Product X, those performance claims and warranties are 138 | such Commercial Contributor's responsibility alone. Under this section, the 139 | Commercial Contributor would have to defend claims against the other 140 | Contributors related to those performance claims and warranties, and if a 141 | court requires any other Contributor to pay any damages as a result, the 142 | Commercial Contributor must pay those damages. 143 | 144 | 5. NO WARRANTY 145 | 146 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON 147 | AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER 148 | EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR 149 | CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A 150 | PARTICULAR PURPOSE. Each Recipient is solely responsible for determining the 151 | appropriateness of using and distributing the Program and assumes all risks 152 | associated with its exercise of rights under this Agreement , including but 153 | not limited to the risks and costs of program errors, compliance with 154 | applicable laws, damage to or loss of data, programs or equipment, and 155 | unavailability or interruption of operations. 156 | 157 | 6. DISCLAIMER OF LIABILITY 158 | 159 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY 160 | CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, 161 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION 162 | LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 163 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 164 | ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE 165 | EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY 166 | OF SUCH DAMAGES. 167 | 168 | 7. GENERAL 169 | 170 | If any provision of this Agreement is invalid or unenforceable under 171 | applicable law, it shall not affect the validity or enforceability of the 172 | remainder of the terms of this Agreement, and without further action by the 173 | parties hereto, such provision shall be reformed to the minimum extent 174 | necessary to make such provision valid and enforceable. 175 | 176 | If Recipient institutes patent litigation against any entity (including a 177 | cross-claim or counterclaim in a lawsuit) alleging that the Program itself 178 | (excluding combinations of the Program with other software or hardware) 179 | infringes such Recipient's patent(s), then such Recipient's rights granted 180 | under Section 2(b) shall terminate as of the date such litigation is filed. 181 | 182 | All Recipient's rights under this Agreement shall terminate if it fails to 183 | comply with any of the material terms or conditions of this Agreement and 184 | does not cure such failure in a reasonable period of time after becoming 185 | aware of such noncompliance. If all Recipient's rights under this Agreement 186 | terminate, Recipient agrees to cease use and distribution of the Program as 187 | soon as reasonably practicable. However, Recipient's obligations under this 188 | Agreement and any licenses granted by Recipient relating to the Program shall 189 | continue and survive. 190 | 191 | Everyone is permitted to copy and distribute copies of this Agreement, but in 192 | order to avoid inconsistency the Agreement is copyrighted and may only be 193 | modified in the following manner. The Agreement Steward reserves the right to 194 | publish new versions (including revisions) of this Agreement from time to 195 | time. No one other than the Agreement Steward has the right to modify this 196 | Agreement. The Eclipse Foundation is the initial Agreement Steward. The 197 | Eclipse Foundation may assign the responsibility to serve as the Agreement 198 | Steward to a suitable separate entity. Each new version of the Agreement will 199 | be given a distinguishing version number. The Program (including 200 | Contributions) may always be distributed subject to the version of the 201 | Agreement under which it was received. In addition, after a new version of 202 | the Agreement is published, Contributor may elect to distribute the Program 203 | (including its Contributions) under the new version. Except as expressly 204 | stated in Sections 2(a) and 2(b) above, Recipient receives no rights or 205 | licenses to the intellectual property of any Contributor under this 206 | Agreement, whether expressly, by implication, estoppel or otherwise. All 207 | rights in the Program not expressly granted under this Agreement are 208 | reserved. 209 | 210 | This Agreement is governed by the laws of the State of New York and the 211 | intellectual property laws of the United States of America. No party to this 212 | Agreement will bring a legal action under this Agreement more than one year 213 | after the cause of action arose. Each party waives its rights to a jury trial 214 | in any resulting litigation. 215 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # typeops 2 | 3 | Alternative type outcomes for arithmetic in Clojure. 4 | 5 | [API](https://inqwell.github.io/typeops/index.html) 6 | 7 | [![Clojars Project](http://clojars.org/typeops/latest-version.svg)](http://clojars.org/typeops) 8 | 9 | `[typeops "0.1.2"]` 10 | 11 | * In Clojure, functions are agnostic about argument types, yet the host platform is not and likely 12 | neither is your database. 13 | 14 | * If you are writing a calculation engine then in many cases floating point 15 | types are unsuitable - inaccuracies will accumulate making results unpredictable. 16 | 17 | * Value type systems and how the types combine are a policy decision. While 18 | Clojure supports integer and floating point types, and mostly makes precise 19 | decimal usage transparent, the way these combine as operands in the 20 | arithmetic functions may not be to your liking. 21 | 22 | OK: 23 | ```clojure 24 | (/ 123.456M 3) 25 | => 41.152M 26 | ``` 27 | 28 | Not OK: 29 | ```clojure 30 | (/ 123.457M 3) 31 | ArithmeticException Non-terminating decimal expansion; 32 | no exact representable decimal result. 33 | java.math.BigDecimal.divide (BigDecimal.java:1690) 34 | ``` 35 | 36 | We can get round this using `with-precision` : 37 | ```clojure 38 | (with-precision 5 39 | (/ 123.457M 3)) 40 | => 41.152M 41 | ``` 42 | but this taints the code, forcing us to be aware of the underlying types, 43 | and what precision do we choose if our interest is accuracy? 44 | 45 | If you are using `decimal` it doesn't make sense to allow these to combine 46 | with floating point: 47 | ```clojure 48 | (* 123.457M 3.142) 49 | => 387.90189399999997 50 | ``` 51 | If you want to avoid `ratio` preferring integer arithmetic, again, you have to be 52 | explicit: 53 | ```clojure 54 | (/ 4 3) 55 | => 4/3 56 | 57 | (quot 4 3) 58 | => 1 59 | ``` 60 | Typeops does the following for `+` `-` `*` and `/` : 61 | 62 | * Integer arithmetic gives a (truncated) integer result 63 | 64 | * Intermediate results do not lose accuracy 65 | 66 | * decimals cannot combine with floating point 67 | 68 | ## "assign" 69 | If you are modelling domain types it is useful to "assign" fields according to 70 | their underlying type and accuracy, rather than say relying on your database 71 | to do this for you: 72 | ```clojure 73 | (def m 74 | {:Integer 0, 75 | :Decimal2 0.00M, 76 | :Short 0, 77 | :Decimal 0E-15M, 78 | :Float 0.0, 79 | :Long 1, 80 | :Byte 0, 81 | :Double 0.0, 82 | :String ""}) 83 | 84 | (assoc m :Decimal2 2.7182818M) 85 | => {:Integer 0, 86 | :Decimal2 2.72M, 87 | :Short 0, 88 | :Decimal 0E-15M, 89 | :Float 0.0, 90 | :Long 1, 91 | :Byte 0, 92 | :Double 0.0, 93 | :String ""} 94 | ``` 95 | ### nil 96 | If your domain model permits `NULL` values you can represent these as `nil` in 97 | Clojure. This destroys the type information however if a map has meta data: 98 | ```clojure 99 | (meta m) 100 | => {:proto {:Integer 0, :Decimal2 0.00M, ...}} 101 | ``` 102 | then "assigning" away from `nil` will use the corresponding field in 103 | the `:proto` map to align the type. 104 | 105 | ### Non-numerics 106 | For non-numeric fields typeops will use any :proto to keep map values as their intended 107 | type. Attempting to "assign" something that is false for `instance?` results in an 108 | exception 109 | 110 | ### Error Handling 111 | Typeops uses dynamic vars to help with error handling and debugging. Bind `*debug*` 112 | to `true` to carry information about type-incompatible `assoc` operations out via 113 | the exception. 114 | ```clojure 115 | (binding [typeops.core/*debug* true] 116 | (assoc m :Integer "foo")) 117 | 118 | => ExceptionInfo Incompatible type for operation: class java.lang.String clojure.core/ex-info (core.clj:4617) 119 | *e 120 | 121 | => #error{:cause "Incompatible type for operation: class java.lang.String", 122 | :data {:map {:Integer 0, 123 | :Decimal2 0.00M, 124 | :Short 0, 125 | :Decimal 0E-15M, 126 | :Float 0.0, 127 | :Date #inst"2019-03-28T17:14:27.816-00:00", 128 | :Long 1, 129 | :Byte 0, 130 | :Double 0.0, 131 | :String ""}, 132 | :key :Integer, 133 | :val "foo", 134 | :cur 0}, 135 | :via [{:type clojure.lang.ExceptionInfo, 136 | :message "Incompatible type for operation: class java.lang.String" 137 | . 138 | . 139 | ``` 140 | 141 | Bind `*warn-on-absent-key*` to a function of two arguments `(fn [m k] ...)` which will 142 | be called when `assoc` puts a key into a map that wasn't there before. 143 | ``` 144 | (binding [typeops.assign/*warn-on-absent-key* 145 | (fn [m k] 146 | (println k "Boo!"))] 147 | (assoc m :Absent "foo")) 148 | :Absent Boo! 149 | => {:Absent "foo", 150 | :Integer 0, 151 | :Decimal2 0.00M, 152 | :Short 0, 153 | :Decimal 0E-15M, 154 | :Float 0.0, 155 | :Date #inst"2019-03-28T17:14:27.816-00:00", 156 | :Long 1, 157 | :Byte 0, 158 | :Double 0.0, 159 | :String ""} 160 | ``` 161 | 162 | ## Usage 163 | 164 | ### Per Namespace 165 | ```clojure 166 | (ns myns 167 | (:refer-clojure :exclude [+ - * / assoc merge]) 168 | (:require [typeops.core :refer :all]) 169 | (:require [typeops.assign :refer :all])) 170 | 171 | (+ 3.142M 2.7182818M) 172 | => 5.8602818M 173 | 174 | (- 3.142M 2.7182818M 3.142M) 175 | => -2.7182818M 176 | 177 | (* 3.142M 2.7182818M 3.142M) 178 | => 26.8353237278152M 179 | 180 | (/ 3.142M 2.7182818M 0.1234M) 181 | => 9.368M 182 | 183 | (assoc my-map k v ... ks vs) ; assoc preserves type and precision 184 | (assign my-map k v ... ks vs) ; same as above 185 | 186 | ``` 187 | 188 | ### Globally 189 | Call the function `init-global!` somewhere in your system start up to 190 | alter the vars `+` `-` `*` and `/` in `clojure.core`. 191 | 192 | ## License 193 | 194 | Copyright © 2018-2019 Inqwell Ltd 195 | 196 | Distributed under the Eclipse Public License either version 1.0 or (at 197 | your option) any later version. 198 | -------------------------------------------------------------------------------- /doc/intro.md: -------------------------------------------------------------------------------- 1 | # Introduction to typeops 2 | 3 | Alternative type outcomes for arithmetic in Clojure. 4 | 5 | [![Clojars Project](http://clojars.org/typeops/latest-version.svg)](http://clojars.org/typeops) 6 | 7 | `[typeops "0.1.2"]` 8 | 9 | * In Clojure, functions are agnostic about argument types, yet the host platform is not and likely 10 | neither is your database. 11 | 12 | * If you are writing a calculation engine then in many cases floating point 13 | types are unsuitable - inaccuracies will accumulate making results unpredictable. 14 | 15 | * Value type systems and how the types combine are a policy decision. While 16 | Clojure supports integer and floating point types, and mostly makes precise 17 | decimal usage transparent, the way these combine as operands in the 18 | arithmetic functions may not be to your liking. 19 | 20 | OK: 21 | ```clojure 22 | (/ 123.456M 3) 23 | => 41.152M 24 | ``` 25 | 26 | Not OK: 27 | ```clojure 28 | (/ 123.457M 3) 29 | ArithmeticException Non-terminating decimal expansion; 30 | no exact representable decimal result. 31 | java.math.BigDecimal.divide (BigDecimal.java:1690) 32 | ``` 33 | 34 | We can get round this using `with-precision` : 35 | ```clojure 36 | (with-precision 5 37 | (/ 123.457M 3)) 38 | => 41.152M 39 | ``` 40 | but this taints the code, forcing us to be aware of the underlying types, 41 | and what precision do we choose if our interest is accuracy? 42 | 43 | If you are using `decimal` it doesn't make sense to allow these to combine 44 | with floating point: 45 | ```clojure 46 | (* 123.457M 3.142) 47 | => 387.90189399999997 48 | ``` 49 | If you want to avoid `ratio` preferring integer arithmetic, again, you have to be 50 | explicit: 51 | ```clojure 52 | (/ 4 3) 53 | => 4/3 54 | 55 | (quot 4 3) 56 | => 1 57 | ``` 58 | Typeops does the following for `+` `-` `*` and `/` : 59 | 60 | * Integer arithmetic gives a (truncated) integer result 61 | 62 | * Intermediate results do not lose accuracy 63 | 64 | * decimals cannot combine with floating point 65 | 66 | ## "assign" 67 | If you are modelling domain types it is useful to "assign" fields according to 68 | their underlying type and accuracy, rather than say relying on your database 69 | to do this for you: 70 | ```clojure 71 | (def m 72 | {:Integer 0, 73 | :Decimal2 0.00M, 74 | :Short 0, 75 | :Decimal 0E-15M, 76 | :Float 0.0, 77 | :Long 1, 78 | :Byte 0, 79 | :Double 0.0, 80 | :String ""}) 81 | 82 | (assoc m :Decimal2 2.7182818M) 83 | => {:Integer 0, 84 | :Decimal2 2.72M, 85 | :Short 0, 86 | :Decimal 0E-15M, 87 | :Float 0.0, 88 | :Long 1, 89 | :Byte 0, 90 | :Double 0.0, 91 | :String ""} 92 | ``` 93 | ### nil 94 | If your domain model permits `NULL` values you can represent these as `nil` in 95 | Clojure. This destroys the type information however if a map has meta data: 96 | ```clojure 97 | (meta m) 98 | => {:proto {:Integer 0, :Decimal2 0.00M, ...}} 99 | ``` 100 | then "assigning" away from `nil` will use the corresponding field in 101 | the `:proto` map to align the type. 102 | 103 | ### Non-numerics 104 | For non-numeric fields typeops will use any :proto to keep map values as their intended 105 | type. Attempting to "assign" something that is false for `instance?` results in an 106 | exception 107 | 108 | ### Error Handling 109 | Typeops uses dynamic vars to help with error handling and debugging. Bind `*debug*` 110 | to `true` to carry information about type-incompatible `assoc` operations out via 111 | the exception. 112 | ```clojure 113 | (binding [typeops.core/*debug* true] 114 | (assoc m :Integer "foo")) 115 | 116 | => ExceptionInfo Incompatible type for operation: class java.lang.String clojure.core/ex-info (core.clj:4617) 117 | *e 118 | 119 | => #error{:cause "Incompatible type for operation: class java.lang.String", 120 | :data {:map {:Integer 0, 121 | :Decimal2 0.00M, 122 | :Short 0, 123 | :Decimal 0E-15M, 124 | :Float 0.0, 125 | :Date #inst"2019-03-28T17:14:27.816-00:00", 126 | :Long 1, 127 | :Byte 0, 128 | :Double 0.0, 129 | :String ""}, 130 | :key :Integer, 131 | :val "foo", 132 | :cur 0}, 133 | :via [{:type clojure.lang.ExceptionInfo, 134 | :message "Incompatible type for operation: class java.lang.String" 135 | . 136 | . 137 | ``` 138 | 139 | Bind `*warn-on-absent-key*` to a function of two arguments `(fn [m k] ...)` which will 140 | be called when `assoc` puts a key into a map that wasn't there before. 141 | ``` 142 | (binding [typeops.assign/*warn-on-absent-key* 143 | (fn [m k] 144 | (println k "Boo!"))] 145 | (assoc m :Absent "foo")) 146 | :Absent Boo! 147 | => {:Absent "foo", 148 | :Integer 0, 149 | :Decimal2 0.00M, 150 | :Short 0, 151 | :Decimal 0E-15M, 152 | :Float 0.0, 153 | :Date #inst"2019-03-28T17:14:27.816-00:00", 154 | :Long 1, 155 | :Byte 0, 156 | :Double 0.0, 157 | :String ""} 158 | ``` 159 | 160 | ## Usage 161 | 162 | ### Per Namespace 163 | ```clojure 164 | (ns myns 165 | (:refer-clojure :exclude [+ - * / assoc merge]) 166 | (:require [typeops.core :refer :all]) 167 | (:require [typeops.assign :refer :all])) 168 | 169 | (+ 3.142M 2.7182818M) 170 | => 5.8602818M 171 | 172 | (- 3.142M 2.7182818M 3.142M) 173 | => -2.7182818M 174 | 175 | (* 3.142M 2.7182818M 3.142M) 176 | => 26.8353237278152M 177 | 178 | (/ 3.142M 2.7182818M 0.1234M) 179 | => 9.368M 180 | 181 | (assoc my-map k v ... ks vs) ; assoc preserves type and precision 182 | (assign my-map k v ... ks vs) ; same as above 183 | 184 | ``` 185 | 186 | ### Globally 187 | Call the function `init-global!` somewhere in your system start up to 188 | alter the vars `+` `-` `*` and `/` in `clojure.core`. 189 | 190 | ## License 191 | 192 | Copyright © 2018-2019 Inqwell Ltd 193 | 194 | Distributed under the Eclipse Public License either version 1.0 or (at 195 | your option) any later version. 196 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject typeops "0.1.2" 2 | :description "Alternative type outcomes for arithmetic" 3 | :url "https://github.com/inqwell/typeops" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :dependencies [[org.clojure/clojure "1.8.0"]] 7 | :codox {:output-path "codox/typeops" 8 | :source-uri "https://github.com/inqwell/typeops/blob/master/{filepath}#L{line}"} 9 | :plugins [[lein-codox "0.10.3"]]) 10 | -------------------------------------------------------------------------------- /src/typeops/assign.clj: -------------------------------------------------------------------------------- 1 | (ns typeops.assign 2 | (:refer-clojure :exclude [assoc merge]) 3 | (:require [typeops.core :as t])) 4 | 5 | (def ^:no-doc core-assoc clojure.core/assoc) 6 | 7 | (def ^:dynamic *warn-on-absent-key* 8 | "May be bound to a function of two arguments. When 'assigning' to 9 | a map key that is absent the function is called passing the map 10 | and the key being applied." 11 | nil) 12 | 13 | (defn- warn-on-absent-key! 14 | "Look for a value to base an assignment on. If the 15 | meta data contains a prototype then use that, otherwise 16 | use any existing value. Optionally call a function 17 | if the key is absent." 18 | [m k] 19 | (when (and *warn-on-absent-key* (not (contains? m k))) 20 | (*warn-on-absent-key* m k)) 21 | (or (-> m 22 | meta 23 | :proto 24 | (get k)) 25 | (get m k))) 26 | 27 | (defn assign 28 | "'assigns' val to the key within map. If the meta data 29 | is a map containing the key :proto the corresponding value 30 | will be used to align the type of val, with rounding or 31 | truncation as necessary. If there is no meta data any existing 32 | value is used to maintain the correct type/precision." 33 | ([map key val] 34 | (let [cur (warn-on-absent-key! map key)] 35 | (if (true? t/*debug*) 36 | (binding [t/*debug* {:map map :key key :val val :cur cur}] 37 | (core-assoc map key (t/op-assign cur val))) 38 | (core-assoc map key (t/op-assign cur val))))) 39 | ([map key val & kvs] 40 | (let [ret (assign map key val)] 41 | (if kvs 42 | (if (next kvs) 43 | (recur ret (first kvs) (second kvs) (nnext kvs)) 44 | (throw (IllegalArgumentException. 45 | "assign expects even number of arguments after map/vector, found odd number"))) 46 | ret)))) 47 | 48 | (def assoc 49 | "An alias for assign" 50 | assign) 51 | 52 | (defn merge 53 | "Returns a map that consists of the rest of the maps conj-ed on to 54 | the first, using assign semantics. If a key occurs in more than 55 | one map, the mapping from the latter (left-to-right) will be the 56 | mapping in the result." 57 | [& maps] 58 | (when (some identity maps) 59 | (reduce (fn [to from] 60 | (let [args (apply concat from)] 61 | (if (seq args) 62 | (apply assign to args) 63 | to))) 64 | maps))) 65 | 66 | -------------------------------------------------------------------------------- /src/typeops/core.clj: -------------------------------------------------------------------------------- 1 | (ns typeops.core 2 | (:refer-clojure :exclude [+ - * /]) 3 | (:import (java.math BigDecimal))) 4 | 5 | (def ^:no-doc core-divide clojure.core//) 6 | (def ^:no-doc core-multiply clojure.core/*) 7 | (def ^:no-doc core-add clojure.core/+) 8 | (def ^:no-doc core-subtract clojure.core/-) 9 | 10 | ; TODO use math context to limit scale of multiplications? 11 | 12 | (def ^:private float-ex "Can't combine arbitrary precision with floating point") 13 | 14 | (def ^:dynamic *rounding* 15 | "The rounding mode applied when decimal accuracy is lost. Defaults 16 | to BigDecimal/ROUND_HALF_UP" 17 | BigDecimal/ROUND_HALF_UP) 18 | 19 | (def ^:dynamic *debug* 20 | "When set to true (not just truthy) any exception thrown 21 | for assoc or merge operations that cause type violations 22 | will carry the data {:map map :key key :val val :cur cur}" 23 | {}) 24 | 25 | (defn- illegal-operand-types 26 | [^String msg] 27 | (throw (ex-info msg *debug*))) 28 | 29 | (defn- unknown-type 30 | [obj] 31 | (throw (ex-info (str "Unknown type for operation: " (type obj)) *debug*))) 32 | 33 | (defn- incompatible-type 34 | [obj] 35 | (throw (ex-info (str "Incompatible type for operation: " (type obj)) *debug*))) 36 | 37 | (defprotocol ^:no-doc ITypedOp 38 | (op-assign [to from]) 39 | (op-divide [dividend divisor]) 40 | (op-multiply [multiplier multiplicand]) 41 | (op-add [addend augend]) 42 | (op-subtract [minuend subtrahend])) 43 | 44 | (defprotocol ^:no-doc IToBigDecimal 45 | (assign-dec [from to]) 46 | (divide-dec [divisor dividend]) 47 | (multiply-dec [multiplicand multiplier]) 48 | (add-dec [augend addend]) 49 | (subtract-dec [subtrahend minuend])) 50 | 51 | (defprotocol ^:no-doc IToDouble 52 | (assign-double [from to]) 53 | (divide-double [divisor dividend]) 54 | (multiply-double [multiplicand multiplier]) 55 | (add-double [augend addend]) 56 | (subtract-double [subtrahend minuend])) 57 | 58 | (defprotocol ^:no-doc IToFloat 59 | (assign-float [from to]) 60 | (divide-float [divisor dividend]) 61 | (multiply-float [multiplicand multiplier]) 62 | (add-float [augend addend]) 63 | (subtract-float [subtrahend minuend])) 64 | 65 | (defprotocol ^:no-doc IToLong 66 | (assign-long [from to]) 67 | (divide-long [divisor dividend]) 68 | (multiply-long [multiplicand multiplier]) 69 | (add-long [augend addend]) 70 | (subtract-long [subtrahend minuend])) 71 | 72 | (defprotocol ^:no-doc IToInteger 73 | (assign-int [from to]) 74 | (divide-int [divisor dividend]) 75 | (multiply-int [multiplicand multiplier]) 76 | (add-int [augend addend]) 77 | (subtract-int [subtrahend minuend])) 78 | 79 | (defprotocol ^:no-doc IToShort 80 | (assign-short [from to]) 81 | (divide-short [divisor dividend]) 82 | (multiply-short [multiplicand multiplier]) 83 | (add-short [augend addend]) 84 | (subtract-short [subtrahend minuend])) 85 | 86 | (defprotocol ^:no-doc IToByte 87 | (assign-byte [from to]) 88 | (divide-byte [divisor dividend]) 89 | (multiply-byte [multiplicand multiplier]) 90 | (add-byte [augend addend]) 91 | (subtract-byte [subtrahend minuend])) 92 | 93 | (extend-protocol ITypedOp 94 | BigDecimal 95 | (op-assign [to from] 96 | (assign-dec from to)) 97 | (op-divide [dividend divisor] 98 | (divide-dec divisor dividend)) 99 | (op-multiply [multiplier multiplicand] 100 | (multiply-dec multiplicand multiplier)) 101 | (op-add [addend augend] 102 | (add-dec augend addend)) 103 | (op-subtract [minuend subtrahend] 104 | (subtract-dec subtrahend minuend)) 105 | 106 | Double 107 | (op-assign [to from] 108 | (assign-double from to)) 109 | (op-divide [dividend divisor] 110 | (divide-double divisor dividend)) 111 | (op-multiply [multiplier multiplicand] 112 | (multiply-double multiplicand multiplier)) 113 | (op-add [addend augend] 114 | (add-double augend addend)) 115 | (op-subtract [minuend subtrahend] 116 | (subtract-double subtrahend minuend)) 117 | 118 | Float 119 | (op-assign [to from] 120 | (assign-float from to)) 121 | (op-divide [dividend divisor] 122 | (divide-float divisor dividend)) 123 | (op-multiply [multiplier multiplicand] 124 | (multiply-float multiplicand multiplier)) 125 | (op-add [addend augend] 126 | (add-float augend addend)) 127 | (op-subtract [minuend subtrahend] 128 | (subtract-float subtrahend minuend)) 129 | 130 | Long 131 | (op-assign [to from] 132 | (assign-long from to)) 133 | (op-divide [dividend divisor] 134 | (divide-long divisor dividend)) 135 | (op-multiply [multiplier multiplicand] 136 | (multiply-long multiplicand multiplier)) 137 | (op-add [addend augend] 138 | (add-long augend addend)) 139 | (op-subtract [minuend subtrahend] 140 | (subtract-long subtrahend minuend)) 141 | 142 | Integer 143 | (op-assign [to from] 144 | (assign-int from to)) 145 | (op-divide [dividend divisor] 146 | (divide-int divisor dividend)) 147 | (op-multiply [multiplier multiplicand] 148 | (multiply-int multiplicand multiplier)) 149 | (op-add [addend augend] 150 | (add-int augend addend)) 151 | (op-subtract [minuend subtrahend] 152 | (subtract-int subtrahend minuend)) 153 | 154 | Short 155 | (op-assign [to from] 156 | (assign-short from to)) 157 | (op-divide [dividend divisor] 158 | (divide-short divisor dividend)) 159 | (op-multiply [multiplier multiplicand] 160 | (multiply-short multiplicand multiplier)) 161 | (op-add [addend augend] 162 | (add-short augend addend)) 163 | (op-subtract [minuend subtrahend] 164 | (subtract-short subtrahend minuend)) 165 | 166 | Byte 167 | (op-assign [to from] 168 | (assign-byte from to)) 169 | (op-divide [dividend divisor] 170 | (divide-byte divisor dividend)) 171 | (op-multiply [multiplier multiplicand] 172 | (multiply-byte multiplicand multiplier)) 173 | (op-add [addend augend] 174 | (add-byte augend addend)) 175 | (op-subtract [minuend subtrahend] 176 | (subtract-byte subtrahend minuend)) 177 | 178 | ; If there is no explicit despatch (the current value is a date, say) 179 | ; then allow nil or anything type compatible 180 | Object 181 | (op-assign [to from] 182 | (if (nil? from) 183 | from 184 | (if (instance? (class to) from) 185 | from 186 | (illegal-operand-types (str (class from) " is not type compatible with " (class to)))))) 187 | (op-divide [dividend divisor] 188 | (unknown-type dividend)) 189 | (op-multiply [multiplier multiplicand] 190 | (unknown-type multiplier)) 191 | (op-add [addend augend] 192 | (unknown-type addend)) 193 | (op-subtract [minuend subtrahend] 194 | (unknown-type minuend)) 195 | 196 | ;Assigning away from nil to something else is OK. Everything 197 | ;else is NPE 198 | nil 199 | (op-assign [to from] 200 | from) 201 | (op-divide [dividend divisor] 202 | (throw (NullPointerException.))) 203 | (op-multiply [multiplier multiplicand] 204 | (throw (NullPointerException.))) 205 | (op-add [addend augend] 206 | (throw (NullPointerException.))) 207 | (op-subtract [minuend subtrahend] 208 | (throw (NullPointerException.)))) 209 | 210 | 211 | (extend-protocol IToBigDecimal 212 | BigDecimal 213 | (assign-dec [^BigDecimal from ^BigDecimal to] 214 | (.setScale from (.scale to) *rounding*)) 215 | (divide-dec [^BigDecimal divisor ^BigDecimal dividend] 216 | (.divide dividend divisor *rounding*)) 217 | (multiply-dec [^BigDecimal multiplicand ^BigDecimal multiplier] 218 | (.multiply multiplier multiplicand)) 219 | (add-dec [^BigDecimal augend ^BigDecimal addend] 220 | (.add addend augend)) 221 | (subtract-dec [^BigDecimal subtrahend ^BigDecimal minuend] 222 | (.subtract minuend subtrahend)) 223 | 224 | Double 225 | (assign-dec [^Double from ^BigDecimal to] 226 | (illegal-operand-types float-ex)) 227 | (divide-dec [^Double divisor ^BigDecimal dividend] 228 | (illegal-operand-types float-ex)) 229 | (multiply-dec [^Double multiplicand ^BigDecimal multiplier] 230 | (illegal-operand-types float-ex)) 231 | (add-dec [^Double augend ^BigDecimal addend] 232 | (illegal-operand-types float-ex)) 233 | (subtract-dec [^Double subtrahend ^BigDecimal minuend] 234 | (illegal-operand-types float-ex)) 235 | 236 | Float 237 | (assign-dec [^Float from ^BigDecimal to] 238 | (illegal-operand-types float-ex)) 239 | (divide-dec [^Float divisor ^BigDecimal dividend] 240 | (illegal-operand-types float-ex)) 241 | (multiply-dec [^Float multiplicand ^BigDecimal multiplier] 242 | (illegal-operand-types float-ex)) 243 | (add-dec [^Float augend ^BigDecimal addend] 244 | (illegal-operand-types float-ex)) 245 | (subtract-dec [^Float subtrahend ^BigDecimal minuend] 246 | (illegal-operand-types float-ex)) 247 | 248 | Long 249 | (assign-dec [^Long from ^BigDecimal to] 250 | (.setScale (BigDecimal. (.longValue from)) 251 | (.scale to) 252 | *rounding*)) 253 | (divide-dec [^Long divisor ^BigDecimal dividend] 254 | (.divide dividend 255 | (BigDecimal. (.longValue divisor)) 256 | *rounding*)) 257 | (multiply-dec [^Long multiplicand ^BigDecimal multiplier] 258 | (.multiply multiplier (BigDecimal. (.longValue multiplicand)))) 259 | (add-dec [^Long augend ^BigDecimal addend] 260 | (.add addend (BigDecimal. (.longValue augend)))) 261 | (subtract-dec [^Long subtrahend ^BigDecimal minuend] 262 | (.subtract minuend (BigDecimal. (.longValue subtrahend)))) 263 | 264 | Integer 265 | (assign-dec [^Integer from ^BigDecimal to] 266 | (.setScale (BigDecimal. (.intValue from)) 267 | (.scale to) 268 | *rounding*)) 269 | (divide-dec [^Integer divisor ^BigDecimal dividend] 270 | (.divide dividend 271 | (BigDecimal. (.intValue divisor)) 272 | *rounding*)) 273 | (multiply-dec [^Integer multiplicand ^BigDecimal multiplier] 274 | (.multiply multiplier (BigDecimal. (.intValue multiplicand)))) 275 | (add-dec [^Integer augend ^BigDecimal addend] 276 | (.add addend (BigDecimal. (.intValue augend)))) 277 | (subtract-dec [^Integer subtrahend ^BigDecimal minuend] 278 | (.subtract minuend (BigDecimal. (.intValue subtrahend)))) 279 | 280 | Short 281 | (assign-dec [^Short from ^BigDecimal to] 282 | (.setScale (BigDecimal. (.intValue from)) 283 | (.scale to) 284 | *rounding*)) 285 | (divide-dec [^Short divisor ^BigDecimal dividend] 286 | (.divide dividend 287 | (BigDecimal. (.intValue divisor)) 288 | *rounding*)) 289 | (multiply-dec [^Short multiplicand ^BigDecimal multiplier] 290 | (.multiply multiplier (BigDecimal. (.intValue multiplicand)))) 291 | (add-dec [^Short augend ^BigDecimal addend] 292 | (.add addend (BigDecimal. (.intValue augend)))) 293 | (subtract-dec [^Short subtrahend ^BigDecimal minuend] 294 | (.subtract minuend (BigDecimal. (.intValue subtrahend)))) 295 | 296 | Byte 297 | (assign-dec [^Byte from ^BigDecimal to] 298 | (.setScale (BigDecimal. (.intValue from)) 299 | (.scale to) 300 | *rounding*)) 301 | (divide-dec [^Byte divisor ^BigDecimal dividend] 302 | (.divide dividend 303 | (BigDecimal. (.intValue divisor)) 304 | *rounding*)) 305 | (multiply-dec [^Byte multiplicand ^BigDecimal multiplier] 306 | (.multiply multiplier (BigDecimal. (.intValue multiplicand)))) 307 | (add-dec [^Byte augend ^BigDecimal addend] 308 | (.add addend (BigDecimal. (.intValue augend)))) 309 | (subtract-dec [^Byte subtrahend ^BigDecimal minuend] 310 | (.subtract minuend (BigDecimal. (.intValue subtrahend)))) 311 | 312 | Object 313 | (assign-dec [from to] 314 | (incompatible-type from)) 315 | (divide-dec [divisor dividend] 316 | (incompatible-type dividend)) 317 | (multiply-dec [ multiplicand multiplier] 318 | (incompatible-type multiplier)) 319 | (add-dec [augend addend] 320 | (incompatible-type addend)) 321 | (subtract-dec [subtrahend minuend] 322 | (incompatible-type minuend)) 323 | 324 | ; It is meaningful to assign to nil, in the way of that 325 | ; being NULL for a DB column for example. 326 | nil 327 | (assign-dec [from to] 328 | from) 329 | (divide-dec [divisor dividend] 330 | (throw (NullPointerException.))) 331 | (multiply-dec [multiplicand multiplier] 332 | (throw (NullPointerException.))) 333 | (add-dec [augend addend] 334 | (throw (NullPointerException.))) 335 | (subtract-dec [subtrahend minuend] 336 | (throw (NullPointerException.)))) 337 | 338 | (extend-protocol IToDouble 339 | BigDecimal 340 | (assign-double [^BigDecimal from ^Double to] 341 | (illegal-operand-types float-ex)) 342 | (divide-double [^BigDecimal divisor ^Double dividend] 343 | (illegal-operand-types float-ex)) 344 | (multiply-double [^BigDecimal multiplicand ^Double multiplier] 345 | (illegal-operand-types float-ex)) 346 | (add-double [^BigDecimal augend ^Double addend] 347 | (illegal-operand-types float-ex)) 348 | (subtract-double [^BigDecimal subtrahend ^Double minuend] 349 | (illegal-operand-types float-ex)) 350 | 351 | Double 352 | (assign-double [^Double from ^Double to] 353 | from) 354 | (divide-double [^Double divisor ^Double dividend] 355 | (core-divide dividend divisor)) 356 | (multiply-double [^Double multiplicand ^Double multiplier] 357 | (core-multiply multiplier multiplicand)) 358 | (add-double [^Double augend ^Double addend] 359 | (core-add addend augend)) 360 | (subtract-double [^Double subtrahend ^Double minuend] 361 | (core-subtract minuend subtrahend)) 362 | 363 | Float 364 | (assign-double [^Float from ^Double to] 365 | (.doubleValue from)) 366 | (divide-double [^Float divisor ^Double dividend] 367 | (core-divide dividend (double divisor))) 368 | (multiply-double [^Float multiplicand ^Double multiplier] 369 | (core-multiply multiplier (double multiplicand))) 370 | (add-double [^Float augend ^Double addend] 371 | (core-add addend (double augend))) 372 | (subtract-double [^Float subtrahend ^Double minuend] 373 | (core-subtract minuend (double subtrahend))) 374 | 375 | Long 376 | (assign-double [^Long from ^Double to] 377 | (double from)) 378 | (divide-double [^Long divisor ^Double dividend] 379 | (core-divide dividend (double divisor))) 380 | (multiply-double [^Long multiplicand ^Double multiplier] 381 | (core-multiply multiplier (double multiplicand))) 382 | (add-double [^Long augend ^Double addend] 383 | (core-add addend (double augend))) 384 | (subtract-double [^Long subtrahend ^Double minuend] 385 | (core-subtract minuend (double subtrahend))) 386 | 387 | Integer 388 | (assign-double [^Integer from ^Double to] 389 | (double from)) 390 | (divide-double [^Integer divisor ^Double dividend] 391 | (core-divide dividend (double divisor))) 392 | (multiply-double [^Integer multiplicand ^Double multiplier] 393 | (core-multiply multiplier (double multiplicand))) 394 | (add-double [^Integer augend ^Double addend] 395 | (core-add addend (double augend))) 396 | (subtract-double [^Integer subtrahend ^Double minuend] 397 | (core-subtract minuend (double subtrahend))) 398 | 399 | Short 400 | (assign-double [^Short from ^Double to] 401 | (double from)) 402 | (divide-double [^Short divisor ^Double dividend] 403 | (core-divide dividend (double divisor))) 404 | (multiply-double [^Short multiplicand ^Double multiplier] 405 | (core-multiply multiplier (double multiplicand))) 406 | (add-double [^Short augend ^Double addend] 407 | (core-add addend (double augend))) 408 | (subtract-double [^Short subtrahend ^Double minuend] 409 | (core-subtract minuend (double subtrahend))) 410 | 411 | Byte 412 | (assign-double [^Byte from ^Double to] 413 | (double from)) 414 | (divide-double [^Byte divisor ^Double dividend] 415 | (core-divide dividend (double divisor))) 416 | (multiply-double [^Byte multiplicand ^Double multiplier] 417 | (core-multiply multiplier (double multiplicand))) 418 | (add-double [^Byte augend ^Double addend] 419 | (core-add addend (double augend))) 420 | (subtract-double [^Byte subtrahend ^Double minuend] 421 | (core-subtract minuend (double subtrahend))) 422 | 423 | Object 424 | (assign-double [from to] 425 | (incompatible-type from)) 426 | (divide-double [divisor dividend] 427 | (incompatible-type dividend)) 428 | (multiply-double [ multiplicand multiplier] 429 | (incompatible-type multiplier)) 430 | (add-double [augend addend] 431 | (incompatible-type addend)) 432 | (subtract-double [subtrahend minuend] 433 | (incompatible-type minuend)) 434 | 435 | nil 436 | (assign-double [from to] 437 | from) 438 | (divide-double [divisor dividend] 439 | (throw (NullPointerException.))) 440 | (multiply-double [multiplicand multiplier] 441 | (throw (NullPointerException.))) 442 | (add-double [augend addend] 443 | (throw (NullPointerException.))) 444 | (subtract-double [subtrahend minuend] 445 | (throw (NullPointerException.)))) 446 | 447 | 448 | (extend-protocol IToFloat 449 | BigDecimal 450 | (assign-float [^BigDecimal from ^Float to] 451 | (illegal-operand-types float-ex)) 452 | (divide-float [^BigDecimal divisor ^Float dividend] 453 | (illegal-operand-types float-ex)) 454 | (multiply-float [^BigDecimal multiplicand ^Float multiplier] 455 | (illegal-operand-types float-ex)) 456 | (add-float [^BigDecimal augend ^Float addend] 457 | (illegal-operand-types float-ex)) 458 | (subtract-float [^BigDecimal subtrahend ^Float minuend] 459 | (illegal-operand-types float-ex)) 460 | 461 | Double 462 | (assign-float [^Double from ^Float to] 463 | (float from)) 464 | (divide-float [^Double divisor ^Float dividend] 465 | (core-divide (double dividend) divisor)) 466 | (multiply-float [^Double multiplicand ^Float multiplier] 467 | (core-multiply (double multiplier) multiplicand)) 468 | (add-float [^Double augend ^Float addend] 469 | (core-add (double addend) augend)) 470 | (subtract-float [^Double subtrahend ^Float minuend] 471 | (core-subtract (double minuend) subtrahend)) 472 | 473 | Float 474 | (assign-float [^Float from ^Float to] 475 | from) 476 | (divide-float [^Float divisor ^Float dividend] 477 | (core-divide dividend divisor)) 478 | (multiply-float [^Float multiplicand ^Float multiplier] 479 | (core-multiply multiplier multiplicand)) 480 | (add-float [^Float augend ^Float addend] 481 | (core-add addend augend)) 482 | (subtract-float [^Float subtrahend ^Float minuend] 483 | (core-subtract minuend subtrahend)) 484 | 485 | Long 486 | (assign-float [^Long from ^Float to] 487 | (float from)) 488 | (divide-float [^Long divisor ^Float dividend] 489 | (core-divide dividend (double divisor))) 490 | (multiply-float [^Long multiplicand ^Float multiplier] 491 | (core-multiply multiplier (double multiplicand))) 492 | (add-float [^Long augend ^Float addend] 493 | (core-add addend (double augend))) 494 | (subtract-float [^Long subtrahend ^Float minuend] 495 | (core-subtract minuend (double subtrahend))) 496 | 497 | Integer 498 | (assign-float [^Integer from ^Float to] 499 | (float from)) 500 | (divide-float [^Integer divisor ^Float dividend] 501 | (core-divide dividend (double divisor))) 502 | (multiply-float [^Integer multiplicand ^Float multiplier] 503 | (core-multiply multiplier (double multiplicand))) 504 | (add-float [^Integer augend ^Float addend] 505 | (core-add addend (double augend))) 506 | (subtract-float [^Integer subtrahend ^Float minuend] 507 | (core-subtract minuend (double subtrahend))) 508 | 509 | Short 510 | (assign-float [^Short from ^Float to] 511 | (float from)) 512 | (divide-float [^Short divisor ^Float dividend] 513 | (core-divide dividend (double divisor))) 514 | (multiply-float [^Short multiplicand ^Float multiplier] 515 | (core-multiply multiplier (double multiplicand))) 516 | (add-float [^Short augend ^Float addend] 517 | (core-add addend (double augend))) 518 | (subtract-float [^Short subtrahend ^Float minuend] 519 | (core-subtract minuend (double subtrahend))) 520 | 521 | Byte 522 | (assign-float [^Byte from ^Float to] 523 | (float from)) 524 | (divide-float [^Byte divisor ^Float dividend] 525 | (core-divide dividend (double divisor))) 526 | (multiply-float [^Byte multiplicand ^Float multiplier] 527 | (core-multiply multiplier (double multiplicand))) 528 | (add-float [^Byte augend ^Float addend] 529 | (core-add addend (double augend))) 530 | (subtract-float [^Byte subtrahend ^Float minuend] 531 | (core-subtract minuend (double subtrahend))) 532 | 533 | Object 534 | (assign-float [from to] 535 | (incompatible-type from)) 536 | (divide-float [divisor dividend] 537 | (incompatible-type dividend)) 538 | (multiply-float [ multiplicand multiplier] 539 | (incompatible-type multiplier)) 540 | (add-float [augend addend] 541 | (incompatible-type addend)) 542 | (subtract-float [subtrahend minuend] 543 | (incompatible-type minuend)) 544 | 545 | nil 546 | (assign-float [from to] 547 | from) 548 | (divide-float [divisor dividend] 549 | (throw (NullPointerException.))) 550 | (multiply-float [multiplicand multiplier] 551 | (throw (NullPointerException.))) 552 | (add-float [augend addend] 553 | (throw (NullPointerException.))) 554 | (subtract-float [subtrahend minuend] 555 | (throw (NullPointerException.)))) 556 | 557 | 558 | (extend-protocol IToLong 559 | BigDecimal 560 | (assign-long [^BigDecimal from ^Long to] 561 | (long from)) 562 | (divide-long [^BigDecimal divisor ^Long dividend] 563 | (-> (BigDecimal. (long dividend)) 564 | (.setScale (.scale divisor)) 565 | (.divide divisor *rounding*))) 566 | (multiply-long [^BigDecimal multiplicand ^Long multiplier] 567 | (-> (BigDecimal. (long multiplier)) 568 | (.multiply multiplicand))) 569 | (add-long [^BigDecimal augend ^Long addend] 570 | (-> (BigDecimal. (long addend)) 571 | (.setScale (.scale augend)) 572 | (.add augend))) 573 | (subtract-long [^BigDecimal subtrahend ^Long minuend] 574 | (-> (BigDecimal. (long minuend)) 575 | (.setScale (.scale subtrahend)) 576 | (.subtract subtrahend))) 577 | 578 | Double 579 | (assign-long [^Double from ^Long to] 580 | (long from)) 581 | (divide-long [^Double divisor ^Long dividend] 582 | (core-divide (double dividend) divisor)) 583 | (multiply-long [^Double multiplicand ^Long multiplier] 584 | (core-multiply (double multiplier) multiplicand)) 585 | (add-long [^Double augend ^Long addend] 586 | (core-add (double addend) augend)) 587 | (subtract-long [^Double subtrahend ^Long minuend] 588 | (core-subtract (double minuend) subtrahend)) 589 | 590 | Float 591 | (assign-long [^Float from ^Long to] 592 | (long from)) 593 | (divide-long [^Float divisor ^Long dividend] 594 | (core-divide (float dividend) divisor)) 595 | (multiply-long [^Float multiplicand ^Long multiplier] 596 | (core-multiply (float multiplier) multiplicand)) 597 | (add-long [^Float augend ^Long addend] 598 | (core-add (float addend) augend)) 599 | (subtract-long [^Float subtrahend ^Long minuend] 600 | (core-subtract (float minuend) subtrahend)) 601 | 602 | Long 603 | (assign-long [^Long from ^Long to] 604 | from) 605 | (divide-long [^Long divisor ^Long dividend] 606 | (quot dividend divisor)) 607 | (multiply-long [^Long multiplicand ^Long multiplier] 608 | (core-multiply multiplier multiplicand)) 609 | (add-long [^Long augend ^Long addend] 610 | (core-add addend augend)) 611 | (subtract-long [^Long subtrahend ^Long minuend] 612 | (core-subtract minuend subtrahend)) 613 | 614 | Integer 615 | (assign-long [^Integer from ^Long to] 616 | (.longValue from)) 617 | (divide-long [^Integer divisor ^Long dividend] 618 | (quot dividend divisor)) 619 | (multiply-long [^Integer multiplicand ^Long multiplier] 620 | (core-multiply multiplier multiplicand)) 621 | (add-long [^Integer augend ^Long addend] 622 | (core-add addend augend)) 623 | (subtract-long [^Integer subtrahend ^Long minuend] 624 | (core-subtract minuend subtrahend)) 625 | 626 | Short 627 | (assign-long [^Short from ^Long to] 628 | (.longValue from)) 629 | (divide-long [^Short divisor ^Long dividend] 630 | (quot dividend divisor)) 631 | (multiply-long [^Short multiplicand ^Long multiplier] 632 | (core-multiply multiplier multiplicand)) 633 | (add-long [^Short augend ^Long addend] 634 | (core-add addend augend)) 635 | (subtract-long [^Short subtrahend ^Long minuend] 636 | (core-subtract minuend subtrahend)) 637 | 638 | Byte 639 | (assign-long [^Byte from ^Long to] 640 | (.longValue from)) 641 | (divide-long [^Byte divisor ^Long dividend] 642 | (quot dividend divisor)) 643 | (multiply-long [^Byte multiplicand ^Long multiplier] 644 | (core-multiply multiplier multiplicand)) 645 | (add-long [^Byte augend ^Long addend] 646 | (core-add addend augend)) 647 | (subtract-long [^Byte subtrahend ^Long minuend] 648 | (core-subtract minuend subtrahend)) 649 | 650 | Object 651 | (assign-long [from to] 652 | (incompatible-type from)) 653 | (divide-long [divisor dividend] 654 | (incompatible-type divisor)) 655 | (multiply-long [multiplicand multiplier] 656 | (incompatible-type multiplicand)) 657 | (add-long [augend addend] 658 | (incompatible-type augend)) 659 | (subtract-long [subtrahend minuend] 660 | (incompatible-type subtrahend)) 661 | 662 | nil 663 | (assign-long [from to] 664 | from) 665 | (divide-long [divisor dividend] 666 | (throw (NullPointerException.))) 667 | (multiply-long [multiplicand multiplier] 668 | (throw (NullPointerException.))) 669 | (add-long [augend addend] 670 | (throw (NullPointerException.))) 671 | (subtract-long [subtrahend minuend] 672 | (throw (NullPointerException.)))) 673 | 674 | 675 | (extend-protocol IToInteger 676 | BigDecimal 677 | (assign-int [^BigDecimal from ^Integer to] 678 | (int from)) 679 | (divide-int [^BigDecimal divisor ^Integer dividend] 680 | (-> (BigDecimal. (int dividend)) 681 | (.setScale (.scale divisor)) 682 | (.divide divisor *rounding*))) 683 | (multiply-int [^BigDecimal multiplicand ^Integer multiplier] 684 | (-> (BigDecimal. (int multiplier)) 685 | (.multiply multiplicand))) 686 | (add-int [^BigDecimal augend ^Integer addend] 687 | (-> (BigDecimal. (int addend)) 688 | (.setScale (.scale augend)) 689 | (.add augend))) 690 | (subtract-int [^BigDecimal subtrahend ^Integer minuend] 691 | (-> (BigDecimal. (int minuend)) 692 | (.setScale (.scale subtrahend)) 693 | (.subtract subtrahend))) 694 | 695 | Double 696 | (assign-int [^Double from ^Integer to] 697 | (int from)) 698 | (divide-int [^Double divisor ^Integer dividend] 699 | (core-divide (double dividend) divisor)) 700 | (multiply-int [^Double multiplicand ^Integer multiplier] 701 | (core-multiply (double multiplier) multiplicand)) 702 | (add-int [^Double augend ^Integer addend] 703 | (core-add (double addend) augend)) 704 | (subtract-int [^Double subtrahend ^Integer minuend] 705 | (core-subtract (double minuend) subtrahend)) 706 | 707 | Float 708 | (assign-int [^Float from ^Integer to] 709 | (int from)) 710 | (divide-int [^Float divisor ^Integer dividend] 711 | (core-divide (float dividend) divisor)) 712 | (multiply-int [^Float multiplicand ^Integer multiplier] 713 | (core-multiply (float multiplier) multiplicand)) 714 | (add-int [^Float augend ^Integer addend] 715 | (core-add (float addend) augend)) 716 | (subtract-int [^Float subtrahend ^Integer minuend] 717 | (core-subtract (float minuend) subtrahend)) 718 | 719 | Long 720 | (assign-int [^Long from ^Integer to] 721 | (int from)) 722 | (divide-int [^Long divisor ^Integer dividend] 723 | (int (quot dividend divisor))) 724 | (multiply-int [^Long multiplicand ^Integer multiplier] 725 | (core-multiply multiplier multiplicand)) 726 | (add-int [^Long augend ^Integer addend] 727 | (core-add addend augend)) 728 | (subtract-int [^Long subtrahend ^Integer minuend] 729 | (core-subtract minuend subtrahend)) 730 | 731 | Integer 732 | (assign-int [^Integer from ^Integer to] 733 | from) 734 | (divide-int [^Integer divisor ^Integer dividend] 735 | (int (quot dividend divisor))) 736 | (multiply-int [^Integer multiplicand ^Integer multiplier] 737 | (core-multiply multiplier multiplicand)) 738 | (add-int [^Integer augend ^Integer addend] 739 | (core-add addend augend)) 740 | (subtract-int [^Integer subtrahend ^Integer minuend] 741 | (core-subtract minuend subtrahend)) 742 | 743 | Short 744 | (assign-int [^Short from ^Integer to] 745 | (int from)) 746 | (divide-int [^Short divisor ^Integer dividend] 747 | (int (quot dividend divisor))) 748 | (multiply-int [^Short multiplicand ^Integer multiplier] 749 | (core-multiply multiplier multiplicand)) 750 | (add-int [^Short augend ^Integer addend] 751 | (core-add addend augend)) 752 | (subtract-int [^Short subtrahend ^Integer minuend] 753 | (core-subtract minuend subtrahend)) 754 | 755 | Byte 756 | (assign-int [^Byte from ^Integer to] 757 | (int from)) 758 | (divide-int [^Byte divisor ^Integer dividend] 759 | (int (quot dividend divisor))) 760 | (multiply-int [^Byte multiplicand ^Integer multiplier] 761 | (core-multiply multiplier multiplicand)) 762 | (add-int [^Byte augend ^Integer addend] 763 | (core-add addend augend)) 764 | (subtract-int [^Byte subtrahend ^Integer minuend] 765 | (core-subtract minuend subtrahend)) 766 | 767 | Object 768 | (assign-int [from to] 769 | (incompatible-type from)) 770 | (divide-int [divisor dividend] 771 | (incompatible-type dividend)) 772 | (multiply-int [ multiplicand multiplier] 773 | (incompatible-type multiplier)) 774 | (add-int [augend addend] 775 | (incompatible-type addend)) 776 | (subtract-int [subtrahend minuend] 777 | (incompatible-type minuend)) 778 | 779 | nil 780 | (assign-int [from to] 781 | from) 782 | (divide-int [divisor dividend] 783 | (throw (NullPointerException.))) 784 | (multiply-int [multiplicand multiplier] 785 | (throw (NullPointerException.))) 786 | (add-int [augend addend] 787 | (throw (NullPointerException.))) 788 | (subtract-int [subtrahend minuend] 789 | (throw (NullPointerException.)))) 790 | 791 | (extend-protocol IToShort 792 | BigDecimal 793 | (assign-short [^BigDecimal from ^Short to] 794 | (short from)) 795 | (divide-short [^BigDecimal divisor ^Short dividend] 796 | (-> (BigDecimal. (int dividend)) 797 | (.setScale (.scale divisor)) 798 | (.divide divisor *rounding*))) 799 | (multiply-short [^BigDecimal multiplicand ^Short multiplier] 800 | (-> (BigDecimal. (int multiplier)) 801 | (.multiply multiplicand))) 802 | (add-short [^BigDecimal augend ^Short addend] 803 | (-> (BigDecimal. (int addend)) 804 | (.setScale (.scale augend)) 805 | (.add augend))) 806 | (subtract-short [^BigDecimal subtrahend ^Short minuend] 807 | (-> (BigDecimal. (int minuend)) 808 | (.setScale (.scale subtrahend)) 809 | (.subtract subtrahend))) 810 | 811 | Double 812 | (assign-short [^Double from ^Short to] 813 | (short from)) 814 | (divide-short [^Double divisor ^Short dividend] 815 | (core-divide (double dividend) divisor)) 816 | (multiply-short [^Double multiplicand ^Short multiplier] 817 | (core-multiply (double multiplier) multiplicand)) 818 | (add-short [^Double augend ^Short addend] 819 | (core-add (double addend) augend)) 820 | (subtract-short [^Double subtrahend ^Short minuend] 821 | (core-subtract (double minuend) subtrahend)) 822 | 823 | Float 824 | (assign-short [^Float from ^Short to] 825 | (short from)) 826 | (divide-short [^Float divisor ^Short dividend] 827 | (core-divide (float dividend) divisor)) 828 | (multiply-short [^Float multiplicand ^Short multiplier] 829 | (core-multiply (float multiplier) multiplicand)) 830 | (add-short [^Float augend ^Short addend] 831 | (core-add (float addend) augend)) 832 | (subtract-short [^Float subtrahend ^Short minuend] 833 | (core-subtract (float minuend) subtrahend)) 834 | 835 | Long 836 | (assign-short [^Long from ^Short to] 837 | (short from)) 838 | (divide-short [^Long divisor ^Short dividend] 839 | (short (quot dividend divisor))) 840 | (multiply-short [^Long multiplicand ^Short multiplier] 841 | (core-multiply multiplier multiplicand)) 842 | (add-short [^Long augend ^Short addend] 843 | (core-add addend augend)) 844 | (subtract-short [^Long subtrahend ^Short minuend] 845 | (core-subtract minuend subtrahend)) 846 | 847 | Integer 848 | (assign-short [^Integer from ^Short to] 849 | (short from)) 850 | (divide-short [^Integer divisor ^Short dividend] 851 | (short (quot dividend divisor))) 852 | (multiply-short [^Integer multiplicand ^Short multiplier] 853 | (core-multiply multiplier multiplicand)) 854 | (add-short [^Integer augend ^Short addend] 855 | (core-add addend augend)) 856 | (subtract-short [^Integer subtrahend ^Short minuend] 857 | (core-subtract minuend subtrahend)) 858 | 859 | Short 860 | (assign-short [^Short from ^Short to] 861 | from) 862 | (divide-short [^Short divisor ^Short dividend] 863 | (short (quot dividend divisor))) 864 | (multiply-short [^Short multiplicand ^Short multiplier] 865 | (core-multiply multiplier multiplicand)) 866 | (add-short [^Short augend ^Short addend] 867 | (core-add addend augend)) 868 | (subtract-short [^Short subtrahend ^Short minuend] 869 | (core-subtract minuend subtrahend)) 870 | 871 | Byte 872 | (assign-short [^Byte from ^Short to] 873 | (short from)) 874 | (divide-short [^Byte divisor ^Short dividend] 875 | (short (quot dividend divisor))) 876 | (multiply-short [^Byte multiplicand ^Short multiplier] 877 | (core-multiply multiplier multiplicand)) 878 | (add-short [^Byte augend ^Short addend] 879 | (core-add addend augend)) 880 | (subtract-short [^Byte subtrahend ^Short minuend] 881 | (core-subtract minuend subtrahend)) 882 | 883 | Object 884 | (assign-short [from to] 885 | (incompatible-type from)) 886 | (divide-short [divisor dividend] 887 | (incompatible-type dividend)) 888 | (multiply-short [ multiplicand multiplier] 889 | (incompatible-type multiplier)) 890 | (add-short [augend addend] 891 | (incompatible-type addend)) 892 | (subtract-short [subtrahend minuend] 893 | (incompatible-type minuend)) 894 | 895 | nil 896 | (assign-short [from to] 897 | from) 898 | (divide-short [divisor dividend] 899 | (throw (NullPointerException.))) 900 | (multiply-short [multiplicand multiplier] 901 | (throw (NullPointerException.))) 902 | (add-short [augend addend] 903 | (throw (NullPointerException.))) 904 | (subtract-short [subtrahend minuend] 905 | (throw (NullPointerException.)))) 906 | 907 | (extend-protocol IToByte 908 | BigDecimal 909 | (assign-byte [^BigDecimal from ^Byte to] 910 | (byte from)) 911 | (divide-byte [^BigDecimal divisor ^Byte dividend] 912 | (-> (BigDecimal. (int dividend)) 913 | (.setScale (.scale divisor)) 914 | (.divide divisor *rounding*))) 915 | (multiply-byte [^BigDecimal multiplicand ^Byte multiplier] 916 | (-> (BigDecimal. (int multiplier)) 917 | (.multiply multiplicand))) 918 | (add-byte [^BigDecimal augend ^Byte addend] 919 | (-> (BigDecimal. (int addend)) 920 | (.setScale (.scale augend)) 921 | (.add augend))) 922 | (subtract-byte [^BigDecimal subtrahend ^Byte minuend] 923 | (-> (BigDecimal. (int minuend)) 924 | (.setScale (.scale subtrahend)) 925 | (.subtract subtrahend))) 926 | 927 | Double 928 | (assign-byte [^Double from ^Byte to] 929 | (byte from)) 930 | (divide-byte [^Double divisor ^Byte dividend] 931 | (core-divide (double dividend) divisor)) 932 | (multiply-byte [^Double multiplicand ^Byte multiplier] 933 | (core-multiply (double multiplier) multiplicand)) 934 | (add-byte [^Double augend ^Byte addend] 935 | (core-add (double addend) augend)) 936 | (subtract-byte [^Double subtrahend ^Byte minuend] 937 | (core-subtract (double minuend) subtrahend)) 938 | 939 | Float 940 | (assign-byte [^Float from ^Byte to] 941 | (byte from)) 942 | (divide-byte [^Float divisor ^Byte dividend] 943 | (core-divide (float dividend) divisor)) 944 | (multiply-byte [^Float multiplicand ^Byte multiplier] 945 | (core-multiply (float multiplier) multiplicand)) 946 | (add-byte [^Float augend ^Byte addend] 947 | (core-add (float addend) augend)) 948 | (subtract-byte [^Float subtrahend ^Byte minuend] 949 | (core-subtract (float minuend) subtrahend)) 950 | 951 | Long 952 | (assign-byte [^Long from ^Byte to] 953 | (byte from)) 954 | (divide-byte [^Long divisor ^Byte dividend] 955 | (byte (quot dividend divisor))) 956 | (multiply-byte [^Long multiplicand ^Byte multiplier] 957 | (core-multiply multiplier multiplicand)) 958 | (add-byte [^Long augend ^Byte addend] 959 | (core-add addend augend)) 960 | (subtract-byte [^Long subtrahend ^Byte minuend] 961 | (core-subtract minuend subtrahend)) 962 | 963 | Integer 964 | (assign-byte [^Integer from ^Byte to] 965 | (byte from)) 966 | (divide-byte [^Integer divisor ^Byte dividend] 967 | (byte (quot dividend divisor))) 968 | (multiply-byte [^Integer multiplicand ^Byte multiplier] 969 | (core-multiply multiplier multiplicand)) 970 | (add-byte [^Integer augend ^Byte addend] 971 | (core-add addend augend)) 972 | (subtract-byte [^Integer subtrahend ^Byte minuend] 973 | (core-subtract minuend subtrahend)) 974 | 975 | Short 976 | (assign-byte [^Short from ^Byte to] 977 | (byte from)) 978 | (divide-byte [^Short divisor ^Byte dividend] 979 | (int (quot dividend divisor))) 980 | (multiply-byte [^Short multiplicand ^Byte multiplier] 981 | (core-multiply multiplier multiplicand)) 982 | (add-byte [^Short augend ^Byte addend] 983 | (core-add addend augend)) 984 | (subtract-byte [^Short subtrahend ^Byte minuend] 985 | (core-subtract minuend subtrahend)) 986 | 987 | Byte 988 | (assign-byte [^Byte from ^Byte to] 989 | from) 990 | (divide-byte [^Byte divisor ^Byte dividend] 991 | (short (quot dividend divisor))) 992 | (multiply-byte [^Byte multiplicand ^Byte multiplier] 993 | (core-multiply multiplier multiplicand)) 994 | (add-byte [^Byte augend ^Byte addend] 995 | (core-add addend augend)) 996 | (subtract-byte [^Byte subtrahend ^Byte minuend] 997 | (core-subtract minuend subtrahend)) 998 | 999 | Object 1000 | (assign-byte [from to] 1001 | (incompatible-type from)) 1002 | (divide-byte [divisor dividend] 1003 | (incompatible-type dividend)) 1004 | (multiply-byte [ multiplicand multiplier] 1005 | (incompatible-type multiplier)) 1006 | (add-byte [augend addend] 1007 | (incompatible-type addend)) 1008 | (subtract-byte [subtrahend minuend] 1009 | (incompatible-type minuend)) 1010 | 1011 | nil 1012 | (assign-byte [from to] 1013 | from) 1014 | (divide-byte [divisor dividend] 1015 | (throw (NullPointerException.))) 1016 | (multiply-byte [multiplicand multiplier] 1017 | (throw (NullPointerException.))) 1018 | (add-byte [augend addend] 1019 | (throw (NullPointerException.))) 1020 | (subtract-byte [subtrahend minuend] 1021 | (throw (NullPointerException.)))) 1022 | 1023 | (defn + 1024 | "Returns the sum of nums. (+) returns 0." 1025 | ([] 0) 1026 | ([x] x) 1027 | ([x y] (op-add x y)) 1028 | ([x y & more] 1029 | (reduce + (+ x y) more))) 1030 | 1031 | (defn - 1032 | "If no ys are supplied, returns the negation of x, else subtracts 1033 | the ys from x and returns the result." 1034 | ([x] (core-subtract x)) 1035 | ([x y] (op-subtract x y)) 1036 | ([x y & more] 1037 | (reduce - (- x y) more))) 1038 | 1039 | (defn * 1040 | "Returns the product of nums. (multiply) returns 1." 1041 | ([] 1) 1042 | ([x] x) 1043 | ([x y] (op-multiply x y)) 1044 | ([x y & more] 1045 | (reduce * (* x y) more))) 1046 | 1047 | (defn / 1048 | "If no denominators are supplied, returns 1/numerator, 1049 | else returns numerator divided by all of the denominators." 1050 | ([x] (/ 1 x)) 1051 | ([x y] (op-divide x y)) 1052 | ([x y & more] 1053 | (reduce / (/ x y) more))) 1054 | 1055 | (def ^:private alter-vars 1056 | [#'clojure.core/+ + core-add 1057 | #'clojure.core/- - core-subtract 1058 | #'clojure.core/* * core-multiply 1059 | #'clojure.core// / core-divide]) 1060 | 1061 | (defn- do-alter-vars! 1062 | [action] 1063 | (doseq [[v set-to reset-to] 1064 | (partition 3 alter-vars)] 1065 | (alter-var-root v 1066 | (fn [_] 1067 | (if (= :set action) 1068 | set-to 1069 | reset-to))))) 1070 | 1071 | (defn init-global! 1072 | "Alter the root bindings of vars +, -, * and / to use typeops 1073 | arithmetic operations globally" 1074 | [] 1075 | (do-alter-vars! :set)) 1076 | 1077 | (defn reset-global! 1078 | "Reset the root bindings of vars +, -, * and / to use 1079 | clojure.core arithmetic operations globally" 1080 | [] 1081 | (do-alter-vars! :reset)) 1082 | -------------------------------------------------------------------------------- /test/typeops/assign_test.clj: -------------------------------------------------------------------------------- 1 | (ns typeops.assign-test 2 | (:refer-clojure :exclude [merge assoc]) 3 | (:require [clojure.test :refer :all] 4 | [typeops.assign :refer :all]) 5 | (import clojure.lang.ExceptionInfo)) 6 | 7 | (def m-types {:String "" 8 | :Long 1 9 | :Integer (int 0) 10 | :Decimal 0E-15M 11 | :Short (short 0) 12 | :Decimal2 0.00M 13 | :Double 0.0 14 | :Float (float 0.0) 15 | :Byte (byte 0) 16 | :Date (java.util.Date.)}) 17 | 18 | (def m (with-meta m-types {:proto m-types})) 19 | 20 | (def incompatible-type #"Incompatible type for operation") 21 | 22 | (defn- same-precision 23 | [k m v e] 24 | (let [i1 (or (k m) 25 | (-> m 26 | meta 27 | :proto 28 | k)) 29 | i2 (k (assign m k v)) 30 | c1 (class i1) 31 | c2 (class i2)] 32 | (if-not (= c1 c2) 33 | (throw (IllegalStateException. (str c1 " not same precision as " c2)))) 34 | (if (decimal? i1) 35 | (or (= (.scale i1) (.scale i2)) 36 | (throw (IllegalStateException. (str i1 " not same scale as " i2))))) 37 | (or (= i2 e)))) 38 | 39 | (deftest assign-keep-type 40 | (testing "decimal" 41 | (is (same-precision :Decimal m 1.00M 1.00M)) 42 | (is (thrown? ExceptionInfo (same-precision :Decimal m 1.0 1.00M))) 43 | (is (thrown? ExceptionInfo (same-precision :Decimal m (float 1.0) 1.00M))) 44 | (is (same-precision :Decimal m 1 1.00M)) 45 | (is (same-precision :Decimal m (int 1) 1.00M)) 46 | (is (same-precision :Decimal m (short 1) 1.00M)) 47 | (is (same-precision :Decimal m (byte 1) 1.00M))) 48 | (testing "decimal-round-up" 49 | (is (same-precision :Decimal2 m 1.234M 1.23M)) 50 | (is (same-precision :Decimal2 m 1.235M 1.24M))) 51 | (testing "double" 52 | (is (thrown? ExceptionInfo (same-precision :Double m 12.00M 12.0))) 53 | (is (same-precision :Double m 12.0 12.0)) 54 | (is (same-precision :Double m (float 12.0) 12.0)) 55 | (is (same-precision :Double m 12 12.0)) 56 | (is (same-precision :Double m (int 12) 12.0)) 57 | (is (same-precision :Double m (short 12) 12.0)) 58 | (is (same-precision :Double m (byte 12) 12.0))) 59 | (testing "float" 60 | (is (thrown? ExceptionInfo (same-precision :Float m 12.00M (float 12.0)))) 61 | (is (same-precision :Float m 12.0 (float 12.0))) 62 | (is (same-precision :Float m (float 12.0) (float 12.0))) 63 | (is (same-precision :Float m 12 (float 12.0))) 64 | (is (same-precision :Float m (int 12) (float 12.0))) 65 | (is (same-precision :Float m (short 12) (float 12.0))) 66 | (is (same-precision :Float m (byte 12) (float 12.0)))) 67 | (testing "long" 68 | (is (same-precision :Long m 12.56M 12)) ;truncates 69 | (is (same-precision :Long m 12.1 12)) ;truncates 70 | (is (same-precision :Long m (float 12.8) 12)) ;truncates 71 | (is (same-precision :Long m 12 12)) 72 | (is (same-precision :Long m (int 12) 12)) 73 | (is (same-precision :Long m (short 12) 12)) 74 | (is (same-precision :Long m (byte 12) 12))) 75 | (testing "int" 76 | (is (same-precision :Integer m 12.56M 12)) ;truncates 77 | (is (same-precision :Integer m 12.1 12)) ;truncates 78 | (is (same-precision :Integer m (float 12.8) 12)) ;truncates 79 | (is (same-precision :Integer m 12 12)) 80 | (is (same-precision :Integer m (int 12) 12)) 81 | (is (same-precision :Integer m (short 12) 12)) 82 | (is (same-precision :Integer m (byte 12) 12))) 83 | (testing "short" 84 | (is (same-precision :Short m 12.56M 12)) ;truncates 85 | (is (same-precision :Short m 12.1 12)) ;truncates 86 | (is (same-precision :Short m (float 12.8) 12)) ;truncates 87 | (is (same-precision :Short m 12 12)) 88 | (is (same-precision :Short m (int 12) 12)) 89 | (is (same-precision :Short m (short 12) 12)) 90 | (is (same-precision :Short m (byte 12) 12))) 91 | (testing "byte" 92 | (is (same-precision :Byte m 12.56M 12)) ;truncates 93 | (is (same-precision :Byte m 12.1 12)) ;truncates 94 | (is (same-precision :Byte m (float 12.8) 12)) ;truncates 95 | (is (same-precision :Byte m 12 12)) 96 | (is (same-precision :Byte m (int 12) 12)) 97 | (is (same-precision :Byte m (short 12) 12)) 98 | (is (same-precision :Byte m (byte 12) 12)))) 99 | 100 | (deftest overflow 101 | (testing "byte-overflow" 102 | (is (thrown-with-msg? 103 | IllegalArgumentException #"out of range for byte" 104 | (same-precision :Byte m 512 0)))) 105 | (testing "short-overflow" 106 | (is (thrown-with-msg? 107 | IllegalArgumentException #"out of range for short" 108 | (same-precision :Short m 32768 0)))) 109 | (testing "integer-overflow" 110 | (is (thrown-with-msg? 111 | IllegalArgumentException #"out of range for int" 112 | (same-precision :Integer m 2147483648 0)))) 113 | (comment (testing "long-overflow" 114 | (is (thrown-with-msg? 115 | IllegalArgumentException #"out of range for long" 116 | (same-precision :Long m 9223372036854775909M 0)))))) 117 | 118 | (defn- assign-nil-and-back 119 | [k m v e] 120 | (let [m1 (assign m k nil)] 121 | (same-precision k m1 v e))) 122 | 123 | (deftest to-and-from-nil 124 | (testing "decimal" 125 | (is (assign-nil-and-back :Decimal m 1.00M 1.00M)) 126 | (is (assign-nil-and-back :Decimal2 m 1.234M 1.23M)) 127 | (is (assign-nil-and-back :Decimal2 m 1.235M 1.24M)))) 128 | 129 | (deftest incompatible-types 130 | (testing "incompatible-types" 131 | (is (thrown-with-msg? ExceptionInfo incompatible-type 132 | (assign m :Long m "1"))) 133 | (is (thrown-with-msg? ExceptionInfo incompatible-type 134 | (assign m :Integer m "1"))) 135 | (is (thrown-with-msg? ExceptionInfo incompatible-type 136 | (assign m :Decimal m "1"))) 137 | (is (thrown-with-msg? ExceptionInfo incompatible-type 138 | (assign m :Short m "1"))) 139 | (is (thrown-with-msg? ExceptionInfo incompatible-type 140 | (assign m :Long m "1"))) 141 | (is (thrown-with-msg? ExceptionInfo incompatible-type 142 | (assign m :Float m "1"))) 143 | (is (thrown-with-msg? ExceptionInfo incompatible-type 144 | (assign m :Byte m "1"))))) 145 | 146 | 147 | 148 | (deftest non-numerics 149 | (testing "not-compatible" 150 | (is (thrown-with-msg? 151 | ExceptionInfo #"not type compatible" 152 | (assign m :String 3.142))) 153 | (is (thrown-with-msg? 154 | ExceptionInfo #"not type compatible" 155 | (assign m :Date "Hello, world")))) 156 | (testing "derived" 157 | (is (= (-> (assign m :Date (java.sql.Date. 0)) 158 | :Date) 159 | (java.sql.Date. 0)))) 160 | (testing "derived-and-back" 161 | (let [d (java.util.Date.)] 162 | (is (= (-> (assign m :Date (java.sql.Date. 0)) 163 | (assign :Date d) 164 | :Date) 165 | d))))) 166 | 167 | (deftest missing-key 168 | (testing "missing key" 169 | (let [absent (atom false) 170 | f (fn [m k] 171 | (reset! absent true))] 172 | (binding [typeops.assign/*warn-on-absent-key* f] 173 | (assoc m :absent "Absent!") 174 | (is (true? @absent)))))) 175 | 176 | (deftest not-type-compatible 177 | (testing "debug not-compatible" 178 | (binding [typeops.core/*debug* true] 179 | (try 180 | (assoc m :Long "string") 181 | (catch Exception e 182 | (is (= (-> (.data e) 183 | (select-keys [:val :cur])) 184 | {:val "string" 185 | :cur 1}))))))) 186 | -------------------------------------------------------------------------------- /test/typeops/core_test.clj: -------------------------------------------------------------------------------- 1 | (ns typeops.core-test 2 | (:refer-clojure :exclude [+ - * /]) 3 | (:require [clojure.test :refer :all] 4 | [typeops.core :refer :all]) 5 | (import clojure.lang.ExceptionInfo)) 6 | 7 | (def incompatible-type #"Incompatible type for operation") 8 | 9 | (deftest operand-1-bigdecimal 10 | (testing "bigdecimal" 11 | (is (= (+ 3.142M 2.7182818M) 5.8602818M)) 12 | (is (= (- 3.142M 2.7182818M 3.142M) -2.7182818M)) 13 | (is (= (* 3.142M 2.7182818M 3.142M) 26.8353237278152M)) 14 | (is (= (/ 3.142M 2.7182818M 0.1234M) 9.368M))) 15 | 16 | 17 | (testing "double" 18 | (is (thrown? ExceptionInfo (+ 3.142M 2.718))) 19 | (is (thrown? ExceptionInfo (- 3.142M 2.718))) 20 | (is (thrown? ExceptionInfo (* 3.142M 2.718))) 21 | (is (thrown? ExceptionInfo (/ 3.142M 2.718)))) 22 | 23 | (testing "float" 24 | (is (thrown? ExceptionInfo (+ 3.142M (float 2.718)))) 25 | (is (thrown? ExceptionInfo (- 3.142M (float 2.718)))) 26 | (is (thrown? ExceptionInfo (* 3.142M (float 2.718)))) 27 | (is (thrown? ExceptionInfo (/ 3.142M (float 2.718))))) 28 | 29 | 30 | (testing "long" 31 | (is (= (+ 3.142M 10) 13.142M)) 32 | (is (= (- 3.142M 3 2) -1.858M)) 33 | (is (= (* 3.142M 3 2) 18.852M)) 34 | (is (= (/ 2.99792458E+08M 6 12) 4163784M))) 35 | 36 | 37 | (testing "integer" 38 | (is (= (+ 3.142M (int 10)) 13.142M)) 39 | (is (= (- 3.142M (int 3) (int 2)) -1.858M)) 40 | (is (= (* 3.142M (int 3) (int 2)) 18.852M)) 41 | (is (= (/ 2.99792458E+08M (int 6) (int 12)) 4163784M))) 42 | 43 | 44 | (testing "short" 45 | (is (= (+ 3.142M (short 10)) 13.142M)) 46 | (is (= (- 3.142M (short 3) (short 2)) -1.858M)) 47 | (is (= (* 3.142M (short 3) (short 2)) 18.852M)) 48 | (is (= (/ 2.99792458E+08M (short 6) (short 12)) 4163784M))) 49 | 50 | 51 | (testing "byte" 52 | (is (= (+ 3.142M (byte 10)) 13.142M)) 53 | (is (= (- 3.142M (byte 3) (byte 2)) -1.858M)) 54 | (is (= (* 3.142M (byte 3) (byte 2)) 18.852M)) 55 | (is (= (/ 2.99792458E+08M (byte 6) (byte 12)) 4163784M))) 56 | 57 | 58 | (testing "not-compatible" 59 | (is (thrown-with-msg? ExceptionInfo incompatible-type (+ 3.142M "1"))) 60 | (is (thrown-with-msg? ExceptionInfo incompatible-type (- 3.142M "1"))) 61 | (is (thrown-with-msg? ExceptionInfo incompatible-type (* 3.142M "1"))) 62 | (is (thrown-with-msg? ExceptionInfo incompatible-type (/ 2.99792458E+08M "1"))))) 63 | 64 | 65 | 66 | (deftest operand-1-double 67 | (testing "bigdecimal" 68 | (is (thrown? ExceptionInfo (+ 2.718 3.142M))) 69 | (is (thrown? ExceptionInfo (- 2.718 3.142M))) 70 | (is (thrown? ExceptionInfo (* 2.718 3.142M))) 71 | (is (thrown? ExceptionInfo (/ 2.718 3.142M)))) 72 | 73 | (testing "double" 74 | (is (= (+ 3.142 2.7182818) 5.8602818)) ;hmmm 75 | (is (= (type (+ 3.142 2.7182818)) (type (double 5.8602818)))) 76 | (is (= (- 3.142 2.7182818 3.142) -2.7182818)) 77 | (is (= (type (- 3.142 2.7182818 3.142)) (type (double -2.7182818)))) 78 | (is (= (* 3.142 2.7182818 3.142) 26.8353237278152)) 79 | (is (= (type (* 3.142 2.7182818 3.142)) (type (double 26.8353237278152)))) 80 | (is (= (/ 3.142 2.7182818 0.1234) 9.36691423227006)) 81 | (is (= (type (/ 3.142 2.7182818 0.1234)) (type (double 9.36691423227006))))) 82 | 83 | 84 | (testing "float" 85 | ;(is (= (add 3.142 (float 2.7182818)) 5.8602818)) ;hmmm 86 | (is (= (type (+ 3.142 (float 2.7182818))) (type (double 5.8602818)))) 87 | ;(is (= (subtract 3.142 2.7182818 3.142) -2.7182818)) 88 | (is (= (type (- 3.142 (float 2.7182818) (float 3.142))) (type (double -2.7182818)))) 89 | ;(is (= (multiply 3.142 (float 2.7182818) (float 3.142)) 26.8353237278152)) 90 | (is (= (type (* 3.142 (float 2.7182818) (float 3.142))) (type (double 26.8353237278152)))) 91 | ;(is (= (divide 3.142 (float 2.7182818) (float 0.1234)) 9.36691423227006)) 92 | (is (= (type (/ 3.142 (float 2.7182818) (float 0.1234))) (type (double 9.36691423227006))))) 93 | 94 | 95 | (testing "long" 96 | (is (= (+ 3.142 10) 13.142)) 97 | (is (= (- 3.142 3 2) -1.858)) 98 | (is (= (* 3.142 3 2) 18.852)) 99 | (is (= (/ 2.99792458E+08 6 12) 4163784.1388888885))) 100 | 101 | 102 | (testing "integer" 103 | (is (= (+ 3.142 (int 10)) 13.142)) 104 | (is (= (- 3.142 (int 3) (int 2)) -1.858)) 105 | (is (= (* 3.142 (int 3) (int 2)) 18.852)) 106 | (is (= (/ 2.99792458E+08 (int 6) (int 12)) 4163784.1388888885))) 107 | 108 | 109 | (testing "short" 110 | (is (= (+ 3.142 (short 10)) 13.142)) 111 | (is (= (- 3.142 (short 3) (short 2)) -1.858)) 112 | (is (= (* 3.142 (short 3) (short 2)) 18.852)) 113 | (is (= (/ 2.99792458E+08 (short 6) (short 12)) 4163784.1388888885))) 114 | 115 | 116 | (testing "byte" 117 | (is (= (+ 3.142 (byte 10)) 13.142)) 118 | (is (= (- 3.142 (byte 3) (byte 2)) -1.858)) 119 | (is (= (* 3.142 (byte 3) (byte 2)) 18.852)) 120 | (is (= (/ 2.99792458E+08 (byte 6) (byte 12)) 4163784.1388888885))) 121 | 122 | (testing "not-compatible" 123 | (is (thrown-with-msg? ExceptionInfo incompatible-type (+ 3.142 "1"))) 124 | (is (thrown-with-msg? ExceptionInfo incompatible-type (- 3.142 "1"))) 125 | (is (thrown-with-msg? ExceptionInfo incompatible-type (* 3.142 "1"))) 126 | (is (thrown-with-msg? ExceptionInfo incompatible-type (/ 2.99792458E+08 "1"))))) 127 | 128 | 129 | 130 | 131 | (deftest operand-1-float 132 | (testing "bigdecimal" 133 | (is (thrown? ExceptionInfo (+ (float 2.718) 3.142M))) 134 | (is (thrown? ExceptionInfo (- (float 2.718) 3.142M))) 135 | (is (thrown? ExceptionInfo (* (float 2.718) 3.142M))) 136 | (is (thrown? ExceptionInfo (/ (float 2.718) 3.142M)))) 137 | 138 | (testing "double (produces double)" 139 | ;(is (= (add (float 3.142) 2.7182818) 5.8602818)) ;hmmm 140 | (is (= (type (+ (float 3.142) 2.7182818)) (type (double 5.8602818)))) 141 | ;(is (= (subtract (float 3.142) 2.7182818 3.142) -2.7182818)) 142 | (is (= (type (- (float 3.142) 2.7182818 3.142)) (type (double -2.7182818)))) 143 | ;(is (= (multiply (float 3.142) 2.7182818 3.142) 26.8353237278152)) 144 | (is (= (type (* (float 3.142) 2.7182818 3.142)) (type (double 26.8353237278152)))) 145 | ;(is (= (divide (float 3.142) 2.7182818 0.1234) 9.36691423227006)) 146 | (is (= (type (/ (float 3.142) 2.7182818 0.1234)) (type (double 9.36691423227006))))) 147 | 148 | 149 | (testing "float (produces double)" 150 | ;(is (= (add 3.142 (float 2.7182818)) 5.8602818)) ;hmmm 151 | (is (= (type (+ 3.142 (float 2.7182818))) (type (double 5.8602818)))) 152 | ;(is (= (subtract 3.142 2.7182818 3.142) -2.7182818)) 153 | (is (= (type (- 3.142 (float 2.7182818) (float 3.142))) (type (double -2.7182818)))) 154 | ;(is (= (multiply 3.142 (float 2.7182818) (float 3.142)) 26.8353237278152)) 155 | (is (= (type (* 3.142 (float 2.7182818) (float 3.142))) (type (double 26.8353237278152)))) 156 | ;(is (= (divide 3.142 (float 2.7182818) (float 0.1234)) 9.36691423227006)) 157 | (is (= (type (/ 3.142 (float 2.7182818) (float 0.1234))) (type (double 9.36691423227006))))) 158 | 159 | 160 | (testing "long (produces double)" 161 | ; (is (= (+ (float 3.142) 10) 13.142)) not accurate enough! 162 | (is (= (type (+ (float 3.142) 10)) (type (double 13.142)))) 163 | ; (is (= (- (float 3.142) 3 2) -1.858)) 164 | (is (= (type (- (float 3.142) 3 2)) (type (double -1.858)))) 165 | ; (is (= (* (float 3.142) 3 2) 18.852)) 166 | (is (= (type (* (float 3.142) 3 2)) (type (double 18.852)))) 167 | ; (is (= (/ (float 2.99792458E+08) 6 12) 4163784.0)) 168 | (is (= (type (/ (float 2.99792458E+08) 6 12)) (type (double 4163784.0))))) 169 | 170 | 171 | (testing "integer (produces double)" 172 | ; (is (= (+ (float 3.142) (int 10)) 13.142)) 173 | (is (= (type (+ (float 3.142) (int 10))) (type (double 13.142)))) 174 | ; (is (= (- (float 3.142) (int 3) (int 2)) -1.858)) 175 | (is (= (type (- (float 3.142) (int 3) (int 2))) (type (double -1.858)))) 176 | ; (is (= (* (float 3.142) (int 3) (int 2)) 18.852)) 177 | (is (= (type (* (float 3.142) (int 3) (int 2))) (type (double 18.852)))) 178 | (is (= (/ (float 2.99792458E+08) (int 6) (int 12)) 4163784.0))) 179 | 180 | 181 | (testing "short (produces double)" 182 | ; (is (= (+ (float 3.142) (short 10)) 13.142)) 183 | (is (= (type (+ (float 3.142) (short 10))) (type (double 13.142)))) 184 | ; (is (= (- (float 3.142) (short 3) (short 2)) -1.858)) 185 | (is (= (type (- (float 3.142) (short 3) (short 2))) (type (double -1.858)))) 186 | ; (is (= (* (float 3.142) (short 3) (short 2)) 18.852)) 187 | (is (= (type (* (float 3.142) (short 3) (short 2))) (type (double 18.852)))) 188 | (is (= (/ (float 2.99792458E+08) (short 6) (short 12)) 4163784.0))) 189 | 190 | 191 | (testing "byte (produces double)" 192 | ; (is (= (+ (float 3.142) (byte 10)) 13.142)) 193 | (is (= (type (+ (float 3.142) (byte 10))) (type (double 13.142)))) 194 | ; (is (= (- (float 3.142) (byte 3) (byte 2)) -1.858)) 195 | (is (= (type (- (float 3.142) (byte 3) (byte 2))) (type (double -1.858)))) 196 | ; (is (= (* (float 3.142) (byte 3) (byte 2)) 18.852)) 197 | (is (= (type (* (float 3.142) (byte 3) (byte 2))) (type (double 18.852)))) 198 | (is (= (/ (float 2.99792458E+08) (byte 6) (byte 12)) 4163784.0))) 199 | 200 | 201 | (testing "not-compatible" 202 | (is (thrown-with-msg? ExceptionInfo incompatible-type (+ (float 3.142) "1"))) 203 | (is (thrown-with-msg? ExceptionInfo incompatible-type (- (float 3.142) "1"))) 204 | (is (thrown-with-msg? ExceptionInfo incompatible-type (* (float 3.142) "1"))) 205 | (is (thrown-with-msg? ExceptionInfo incompatible-type (/ (float 2.99792458E+08) "1"))))) 206 | 207 | 208 | (deftest operand-1-long 209 | (testing "bigdecimal" 210 | (is (= (+ 10 3.142M) 13.142M)) 211 | (is (= (- 3 2 3.142M) -2.142M)) 212 | (is (= (* 3 2 3.142M) 18.852M)) 213 | (is (= (/ 299792458 6M 12.00M) 4163784M))) 214 | 215 | (testing "double (produces double)" 216 | ;(is (= (add (float 3.142) 2.7182818) 5.7182818)) ;hmmm 217 | (is (= (type (+ 3 2.7182818)) (type (double 5.7182818)))) 218 | (is (= (- 3 2.7182818 3.142) -2.8602818)) 219 | (is (= (type (- 3 2.7182818 3.142)) (type (double -2.8602818)))) 220 | (is (= (* 3 2.7182818 3.142) 25.6225242468)) 221 | (is (= (type (* 3 2.7182818 3.142)) (type (double 25.6225242468)))) 222 | (is (= (/ 3 2.7182818 0.1234) 8.943584562956774)) 223 | (is (= (type (/ 3 2.7182818 0.1234)) (type (double 8.943584562956774))))) 224 | 225 | (testing "float (produces double)" 226 | ;(is (= (add 3 (float 2.7182818)) 5.7182817459106445)) ;hmmm 227 | (is (= (type (+ 3 (float 2.7182818))) (type (double 5.7182817459106445)))) 228 | ;(is (= (subtract 3 2.7182818 3.142) -2.8602818)) 229 | (is (= (type (- 3 (float 2.7182818) (float 3.142))) (type (double -2.8602818)))) 230 | ;(is (= (multiply 3 (float 2.7182818) (float 3.142)) 25.622523410316944)) 231 | (is (= (type (* 3 (float 2.7182818) (float 3.142))) (type (double 25.622523410316944)))) 232 | ;(is (= (divide 3.142 (float 2.7182818) (float 0.1234)) 8.94358454393072)) 233 | (is (= (type (/ 3 (float 2.7182818) (float 0.1234))) (type (double 8.94358454393072))))) 234 | 235 | 236 | (testing "long" 237 | (is (= (+ 3 10) 13)) 238 | (is (= (+ 3 10 12 14) 39)) 239 | (is (= (- 3 3 -2) 2)) 240 | (is (= (* 3 3 2) 18)) 241 | (is (= (/ 299792458 6 12) 4163784))) 242 | 243 | 244 | (testing "integer (produces long)" 245 | (is (= (+ 3 (int 10)) 13)) 246 | (is (= (- 3 (int 3) (int 2)) -2)) 247 | (is (= (* 3 (int 3) (int 2)) 18)) 248 | (is (= (/ 299792458 (int 6) (int 12)) 4163784))) 249 | 250 | 251 | (testing "short (produces long)" 252 | (is (= (+ 3 (short 10)) 13)) 253 | (is (= (- 3 (short 3) (short 2)) -2)) 254 | (is (= (* 3 (short 3) (short 2)) 18)) 255 | (is (= (/ 299792458 (short 6) (short 12)) 4163784))) 256 | 257 | 258 | (testing "byte (produces long)" 259 | (is (= (+ 3 (byte 10)) 13)) 260 | (is (= (- 3 (byte 3) (byte 2)) -2)) 261 | (is (= (* 3 (byte 3) (byte 2)) 18)) 262 | (is (= (/ 299792458 (byte 6) (byte 12)) 4163784))) 263 | 264 | 265 | (testing "not-compatible" 266 | (is (thrown-with-msg? ExceptionInfo incompatible-type (+ 3 "1"))) 267 | (is (thrown-with-msg? ExceptionInfo incompatible-type (- 3 "1"))) 268 | (is (thrown-with-msg? ExceptionInfo incompatible-type (* 3 "1"))) 269 | (is (thrown-with-msg? ExceptionInfo incompatible-type (/ 299792458 "1"))))) 270 | 271 | 272 | (deftest operand-1-integer 273 | (testing "bigdecimal" 274 | (is (= (+ (int 10) 3.142M) 13.142M)) 275 | (is (= (- (int 3) (int 2) 3.142M) -2.142M)) 276 | (is (= (* (int 3) (int 2) 3.142M) 18.852M)) 277 | (is (= (/ (int 299792458) 6M 12.00M) 4163784M))) 278 | 279 | (testing "double (produces double)" 280 | ;(is (= (add (float 3.142) 2.7182818) 5.7182818)) ;hmmm 281 | (is (= (type (+ (int 3) 2.7182818)) (type (double 5.7182818)))) 282 | ;(is (= (subtract (int 3) 2.7182818 3.142) -2.8602818)) 283 | (is (= (type (- (int 3) 2.7182818 3.142)) (type (double -2.8602818)))) 284 | ;(is (= (multiply (int 3) 2.7182818 3.142) 25.6225242468)) 285 | (is (= (type (* (int 3) 2.7182818 3.142)) (type (double 25.6225242468)))) 286 | ;(is (= (divide (int 3) 2.7182818 0.1234) 8.943584562956774)) 287 | (is (= (type (/ (int 3) 2.7182818 0.1234)) (type (double 8.943584562956774))))) 288 | 289 | (testing "float (produces double)" 290 | ;(is (= (add 3 (float 2.7182818)) 5.7182817459106445)) ;hmmm 291 | (is (= (type (+ (int 3) (float 2.7182818))) (type (double 5.7182817459106445)))) 292 | ;(is (= (subtract 3 2.7182818 3.142) -2.8602818)) 293 | (is (= (type (- (int 3) (float 2.7182818) (float 3.142))) (type (double -2.8602818)))) 294 | ;(is (= (multiply 3 (float 2.7182818) (float 3.142)) 25.622523410316944)) 295 | (is (= (type (* (int 3) (float 2.7182818) (float 3.142))) (type (double 25.622523410316944)))) 296 | ;(is (= (divide 3.142 (float 2.7182818) (float 0.1234)) 8.94358454393072)) 297 | (is (= (type (/ (int 3) (float 2.7182818) (float 0.1234))) (type (double 8.94358454393072))))) 298 | 299 | 300 | (testing "long" 301 | (is (= (+ (int 3) 10) 13)) 302 | (is (= (+ (int 3) 10 12 14) 39)) 303 | (is (= (- (int 3) 3 -2) 2)) 304 | (is (= (* (int 3) 3 2) 18)) 305 | (is (= (/ (int 299792458) 6 12) 4163784))) 306 | 307 | 308 | (testing "integer (produces long)" 309 | (is (= (+ (int 3) (int 10)) 13)) 310 | (is (= (- (int 3) (int 3) (int 2)) -2)) 311 | (is (= (* (int 3) (int 3) (int 2)) 18)) 312 | (is (= (/ (int 299792458) (int 6) (int 12)) 4163784))) 313 | 314 | 315 | (testing "short (produces long)" 316 | (is (= (+ (int 3) (short 10)) 13)) 317 | (is (= (- (int 3) (short 3) (short 2)) -2)) 318 | (is (= (* (int 3) (short 3) (short 2)) 18)) 319 | (is (= (/ (int 299792458) (short 6) (short 12)) 4163784))) 320 | 321 | 322 | (testing "byte (produces long)" 323 | (is (= (+ (int 3) (byte 10)) 13)) 324 | (is (= (- (int 3) (byte 3) (byte 2)) -2)) 325 | (is (= (* (int 3) (byte 3) (byte 2)) 18)) 326 | (is (= (/ (int 299792458) (byte 6) (byte 12)) 4163784))) 327 | 328 | 329 | (testing "not-compatible" 330 | (is (thrown-with-msg? ExceptionInfo incompatible-type (+ (int 3) "1"))) 331 | (is (thrown-with-msg? ExceptionInfo incompatible-type (- (int 3) "1"))) 332 | (is (thrown-with-msg? ExceptionInfo incompatible-type (* (int 3) "1"))) 333 | (is (thrown-with-msg? ExceptionInfo incompatible-type (/ (int 299792458) "1"))))) 334 | 335 | 336 | (deftest operand-1-short 337 | (testing "bigdecimal" 338 | (is (= (+ (short 10) 3.142M) 13.142M)) 339 | (is (= (- (short 3) (short 2) 3.142M) -2.142M)) 340 | (is (= (* (short 3) (short 2) 3.142M) 18.852M)) 341 | (is (= (/ (short 12345) 6.000M 12.00M) 171.458M))) 342 | 343 | (testing "double (produces double)" 344 | ;(is (= (add (float 3.142) 2.7182818) 5.7182818)) ;hmmm 345 | (is (= (type (+ (short 3) 2.7182818)) (type (double 5.7182818)))) 346 | ;(is (= (subtract (short 3) 2.7182818 3.142) -2.8602818)) 347 | (is (= (type (- (short 3) 2.7182818 3.142)) (type (double -2.8602818)))) 348 | ;(is (= (multiply (short 3) 2.7182818 3.142) 25.6225242468)) 349 | (is (= (type (* (short 3) 2.7182818 3.142)) (type (double 25.6225242468)))) 350 | ;(is (= (divide (short 3) 2.7182818 0.1234) 8.943584562956774)) 351 | (is (= (type (/ (short 3) 2.7182818 0.1234)) (type (double 8.943584562956774))))) 352 | 353 | (testing "float (produces double)" 354 | ;(is (= (add 3 (float 2.7182818)) 5.7182817459106445)) ;hmmm 355 | (is (= (type (+ (short 3) (float 2.7182818))) (type (double 5.7182817459106445)))) 356 | ;(is (= (subtract 3 2.7182818 3.142) -2.8602818)) 357 | (is (= (type (- (short 3) (float 2.7182818) (float 3.142))) (type (double -2.8602818)))) 358 | ;(is (= (multiply 3 (float 2.7182818) (float 3.142)) 25.622523410316944)) 359 | (is (= (type (* (short 3) (float 2.7182818) (float 3.142))) (type (double 25.622523410316944)))) 360 | ;(is (= (divide 3.142 (float 2.7182818) (float 0.1234)) 8.94358454393072)) 361 | (is (= (type (/ (short 3) (float 2.7182818) (float 0.1234))) (type (double 8.94358454393072))))) 362 | 363 | 364 | (testing "long" 365 | (is (= (+ (short 3) 10) 13)) 366 | (is (= (+ (short 3) 10 12 14) 39)) 367 | (is (= (- (short 3) 3 -2) 2)) 368 | (is (= (* (short 3) 3 2) 18)) 369 | (is (= (/ (short 12345) 6 12) 171))) 370 | 371 | 372 | (testing "integer (produces long)" 373 | (is (= (+ (short 3) (int 10)) 13)) 374 | (is (= (- (short 3) (int 3) (int 2)) -2)) 375 | (is (= (* (short 3) (int 3) (int 2)) 18)) 376 | (is (= (/ (short 12345) (int 6) (int 12)) 171))) 377 | 378 | 379 | (testing "short (produces long)" 380 | (is (= (+ (short 3) (short 10)) 13)) 381 | (is (= (- (short 3) (short 3) (short 2)) -2)) 382 | (is (= (* (short 3) (short 3) (short 2)) 18)) 383 | (is (= (/ (short 12345) (short 6) (short 12)) 171))) 384 | 385 | 386 | (testing "byte (produces long)" 387 | (is (= (+ (short 3) (byte 10)) 13)) 388 | (is (= (- (short 3) (byte 3) (byte 2)) -2)) 389 | (is (= (* (short 3) (byte 3) (byte 2)) 18)) 390 | (is (= (/ (short 12345) (byte 6) (byte 12)) 171))) 391 | 392 | (testing "not-compatible" 393 | (is (thrown-with-msg? ExceptionInfo incompatible-type (+ (short 3) "1"))) 394 | (is (thrown-with-msg? ExceptionInfo incompatible-type (- (short 3) "1"))) 395 | (is (thrown-with-msg? ExceptionInfo incompatible-type (* (short 3) "1"))) 396 | (is (thrown-with-msg? ExceptionInfo incompatible-type (/ (short 12345) "1"))))) 397 | 398 | 399 | (deftest operand-1-byte 400 | (testing "bigdecimal" 401 | (is (= (+ (byte 10) 3.142M) 13.142M)) 402 | (is (= (- (byte 3) (byte 2) 3.142M) -2.142M)) 403 | (is (= (* (byte 3) (byte 2) 3.142M) 18.852M)) 404 | (is (= (/ (byte 123) 6.000M 12.00M) 1.708M))) 405 | 406 | (testing "double (produces double)" 407 | ;(is (= (add (float 3.142) 2.7182818) 5.7182818)) ;hmmm 408 | (is (= (type (+ (byte 3) 2.7182818)) (type (double 5.7182818)))) 409 | ;(is (= (subtract (byte 3) 2.7182818 3.142) -2.8602818)) 410 | (is (= (type (- (byte 3) 2.7182818 3.142)) (type (double -2.8602818)))) 411 | ;(is (= (multiply (byte 3) 2.7182818 3.142) 25.6225242468)) 412 | (is (= (type (* (byte 3) 2.7182818 3.142)) (type (double 25.6225242468)))) 413 | ;(is (= (divide (byte 3) 2.7182818 0.1234) 8.943584562956774)) 414 | (is (= (type (/ (byte 3) 2.7182818 0.1234)) (type (double 8.943584562956774))))) 415 | 416 | (testing "float (produces double)" 417 | ;(is (= (add 3 (float 2.7182818)) 5.7182817459106445)) ;hmmm 418 | (is (= (type (+ (byte 3) (float 2.7182818))) (type (double 5.7182817459106445)))) 419 | ;(is (= (subtract 3 2.7182818 3.142) -2.8602818)) 420 | (is (= (type (- (byte 3) (float 2.7182818) (float 3.142))) (type (double -2.8602818)))) 421 | ;(is (= (multiply 3 (float 2.7182818) (float 3.142)) 25.622523410316944)) 422 | (is (= (type (* (byte 3) (float 2.7182818) (float 3.142))) (type (double 25.622523410316944)))) 423 | ;(is (= (divide 3.142 (float 2.7182818) (float 0.1234)) 8.94358454393072)) 424 | (is (= (type (/ (byte 3) (float 2.7182818) (float 0.1234))) (type (double 8.94358454393072))))) 425 | 426 | 427 | (testing "long" 428 | (is (= (+ (byte 3) 10) 13)) 429 | (is (= (+ (byte 3) 10 12 14) 39)) 430 | (is (= (- (byte 3) 3 -2) 2)) 431 | (is (= (* (byte 3) 3 2) 18)) 432 | (is (= (/ (byte 123) 6 3) 6))) 433 | 434 | 435 | (testing "integer (produces long)" 436 | (is (= (+ (byte 3) (int 10)) 13)) 437 | (is (= (- (byte 3) (int 3) (int 2)) -2)) 438 | (is (= (* (byte 3) (int 3) (int 2)) 18)) 439 | (is (= (/ (byte 123) (int 6) (int 3)) 6))) 440 | 441 | 442 | (testing "short (produces long)" 443 | (is (= (+ (byte 3) (short 10)) 13)) 444 | (is (= (- (byte 3) (short 3) (short 2)) -2)) 445 | (is (= (* (byte 3) (short 3) (short 2)) 18)) 446 | (is (= (/ (byte 123) (short 6) (short 3)) 6))) 447 | 448 | 449 | (testing "byte (produces long)" 450 | (is (= (+ (byte 3) (byte 10)) 13)) 451 | (is (= (- (byte 3) (byte 3) (byte 2)) -2)) 452 | (is (= (* (byte 3) (byte 3) (byte 2)) 18)) 453 | (is (= (/ (byte 123) (byte 6) (byte 3)) 6))) 454 | 455 | (testing "not-compatible" 456 | (is (thrown-with-msg? ExceptionInfo incompatible-type (+ (byte 3) "1"))) 457 | (is (thrown-with-msg? ExceptionInfo incompatible-type (- (byte 3) "1"))) 458 | (is (thrown-with-msg? ExceptionInfo incompatible-type (* (byte 3) "1"))) 459 | (is (thrown-with-msg? ExceptionInfo incompatible-type (/ (byte 123) "1"))))) 460 | 461 | 462 | (deftest unary-or-none 463 | (testing "add none" 464 | (is (= (+) 0)) 465 | (is (= (+ 2) 2)) 466 | (is (= (- 2) -2)) 467 | (is (= (*) 1)) 468 | (is (= (* 2) 2)) 469 | (is (= (/ 0.5) 2.0)))) 470 | --------------------------------------------------------------------------------