ieee754-0.7.8/000755 000765 000024 00000000000 12643600076 013167 5ustar00ptrckstaff000000 000000 ieee754-0.7.8/cbits/000755 000765 000024 00000000000 12643600076 014273 5ustar00ptrckstaff000000 000000 ieee754-0.7.8/Data/000755 000765 000024 00000000000 12643600076 014040 5ustar00ptrckstaff000000 000000 ieee754-0.7.8/ieee754.cabal000644 000765 000024 00000002112 12643600076 015316 0ustar00ptrckstaff000000 000000 name: ieee754 version: 0.7.8 homepage: http://github.com/patperry/hs-ieee754 synopsis: Utilities for dealing with IEEE floating point numbers description: Utilities for dealing with IEEE floating point numbers, ported from the Tango math library; approximate and exact equality comparisons for general types. category: Math license: BSD3 license-file: LICENSE copyright: (c) 2011-2016. Patrick Perry author: Patrick Perry maintainer: Patrick Perry cabal-version: >= 1.2.0 build-type: Simple tested-with: GHC ==7.6.3 extra-source-files: LICENSE.Tango NEWS cbits/feqrel_source.c tests/Makefile tests/Tests.hs library exposed-modules: Data.AEq Numeric.IEEE extensions: FlexibleInstances ForeignFunctionInterface build-depends: base >= 3 && < 5 ghc-options: -Wall c-sources: cbits/float.c cbits/double.c cc-options: -Wall --std=c99 ieee754-0.7.8/LICENSE000644 000765 000024 00000002705 12643600076 014200 0ustar00ptrckstaff000000 000000 Copyright (c) Patrick Perry 2009 All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ieee754-0.7.8/LICENSE.Tango000644 000765 000024 00000032116 12643600076 015246 0ustar00ptrckstaff000000 000000 Tango is Open Source software, distributed by a group of developers which has been set up for the purpose of providing a vendor-neutral owner of Tango intellectual property. The goals of all Tango licensing decisions are to: * Encourage adoption * Discourage political contention * Encourage collaboration and integration with other projects * Be transparent Tango is dual-licensed: * Academic Free License v3.0 (http://www.dsource.org/projects/tango/wiki/AcademicFreeLicense30) [2] * BSD License (http://www.dsource.org/projects/tango/wiki/BSDLicense) [1][3] The preferred license is the Academic Free License v3.0. All Tango projects release their code under the terms of this license. Both licenses: * Allow commercial use without encumbrance * Provide broad rights to make new products and derivative works * Place no requirement on users to contribute back (although we appreciate it if you do) Users who wish to include Tango with software licensed under the (L)GPL will want to use Tango under the terms of the BSD License. [1] Tango projects may request a variance from the developers to release their projects under additional licenses in conjunction with the AFL. If you have further questions regarding Tango licensing, please do not hesitate to contact us (http://dsource.org/projects/tango/wiki/Contact). [1] The advertising clause has not been a part of the BSD License since July 22, 1999. (ftp://ftp.cs.berkeley.edu/pub/4bsd/README.Impt.License.Change) [2] Academic Free License v3.0 Original Work: Tango Licensor: Tango contributors This Academic Free License (the "License") applies to any original work of authorship (the "Original Work") whose owner (the "Licensor") has placed the following licensing notice adjacent to the copyright notice for the Original Work: Licensed under the Academic Free License version 3.0 1. Grant of Copyright License. Licensor grants You a worldwide, royalty-free, non-exclusive, sublicensable license, for the duration of the copyright, to do the following: a) to reproduce the Original Work in copies, either alone or as part of a collective work; b) to translate, adapt, alter, transform, modify, or arrange the Original Work, thereby creating derivative works ("Derivative Works") based upon the Original Work; c) to distribute or communicate copies of the Original Work and Derivative Works to the public, under any license of your choice that does not contradict the terms and conditions, including Licensor’s reserved rights and remedies, in this Academic Free License; d) to perform the Original Work publicly; and e) to display the Original Work publicly. 2. Grant of Patent License. Licensor grants You a worldwide, royalty-free, non-exclusive, sublicensable license, under patent claims owned or controlled by the Licensor that are embodied in the Original Work as furnished by the Licensor, for the duration of the patents, to make, use, sell, offer for sale, have made, and import the Original Work and Derivative Works. 3. Grant of Source Code License. The term "Source Code" means the preferred form of the Original Work for making modifications to it and all available documentation describing how to modify the Original Work. Licensor agrees to provide a machine-readable copy of the Source Code of the Original Work along with each copy of the Original Work that Licensor distributes. Licensor reserves the right to satisfy this obligation by placing a machine-readable copy of the Source Code in an information repository reasonably calculated to permit inexpensive and convenient access by You for as long as Licensor continues to distribute the Original Work. 4. Exclusions From License Grant. Neither the names of Licensor, nor the names of any contributors to the Original Work, nor any of their trademarks or service marks, may be used to endorse or promote products derived from this Original Work without express prior permission of the Licensor. Except as expressly stated herein, nothing in this License grants any license to Licensor’s trademarks, copyrights, patents, trade secrets or any other intellectual property. No patent license is granted to make, use, sell, offer for sale, have made, or import embodiments of any patent claims other than the licensed claims defined in Section 2. No license is granted to the trademarks of Licensor even if such marks are included in the Original Work. Nothing in this License shall be interpreted to prohibit Licensor from licensing under terms different from this License any Original Work that Licensor otherwise would have a right to license. 5. External Deployment. The term "External Deployment" means the use, distribution, or communication of the Original Work or Derivative Works in any way such that the Original Work or Derivative Works may be used by anyone other than You, whether those works are distributed or communicated to those persons or made available as an application intended for use over a network. As an express condition for the grants of license hereunder, You must treat any External Deployment by You of the Original Work or a Derivative Work as a distribution under section 1(c). 6. Attribution Rights. You must retain, in the Source Code of any Derivative Works that You create, all copyright, patent, or trademark notices from the Source Code of the Original Work, as well as any notices of licensing and any descriptive text identified therein as an "Attribution Notice." You must cause the Source Code for any Derivative Works that You create to carry a prominent Attribution Notice reasonably calculated to inform recipients that You have modified the Original Work. 7. Warranty of Provenance and Disclaimer of Warranty. Licensor warrants that the copyright in and to the Original Work and the patent rights granted herein by Licensor are owned by the Licensor or are sublicensed to You under the terms of this License with the permission of the contributor(s) of those copyrights and patent rights. Except as expressly stated in the immediately preceding sentence, the Original Work is provided under this License on an "AS IS" BASIS and WITHOUT WARRANTY, either express or implied, including, without limitation, the warranties of non-infringement, merchantability or fitness for a particular purpose. THE ENTIRE RISK AS TO THE QUALITY OF THE ORIGINAL WORK IS WITH YOU. This DISCLAIMER OF WARRANTY constitutes an essential part of this License. No license to the Original Work is granted by this License except under this disclaimer. 8. Limitation of Liability. Under no circumstances and under no legal theory, whether in tort (including negligence), contract, or otherwise, shall the Licensor be liable to anyone for any indirect, special, incidental, or consequential damages of any character arising as a result of this License or the use of the Original Work including, without limitation, damages for loss of goodwill, work stoppage, computer failure or malfunction, or any and all other commercial damages or losses. This limitation of liability shall not apply to the extent applicable law prohibits such limitation. 9. Acceptance and Termination. If, at any time, You expressly assented to this License, that assent indicates your clear and irrevocable acceptance of this License and all of its terms and conditions. If You distribute or communicate copies of the Original Work or a Derivative Work, You must make a reasonable effort under the circumstances to obtain the express assent of recipients to the terms of this License. This License conditions your rights to undertake the activities listed in Section 1, including your right to create Derivative Works based upon the Original Work, and doing so without honoring these terms and conditions is prohibited by copyright law and international treaty. Nothing in this License is intended to affect copyright exceptions and limitations (including “fair use” or “fair dealing”). This License shall terminate immediately and You may no longer exercise any of the rights granted to You by this License upon your failure to honor the conditions in Section 1(c). 10. Termination for Patent Action. This License shall terminate automatically and You may no longer exercise any of the rights granted to You by this License as of the date You commence an action, including a cross-claim or counterclaim, against Licensor or any licensee alleging that the Original Work infringes a patent. This termination provision shall not apply for an action alleging patent infringement by combinations of the Original Work with other software or hardware. 11. Jurisdiction, Venue and Governing Law. Any action or suit relating to this License may be brought only in the courts of a jurisdiction wherein the Licensor resides or in which Licensor conducts its primary business, and under the laws of that jurisdiction excluding its conflict-of-law provisions. The application of the United Nations Convention on Contracts for the International Sale of Goods is expressly excluded. Any use of the Original Work outside the scope of this License or after its termination shall be subject to the requirements and penalties of copyright or patent law in the appropriate jurisdiction. This section shall survive the termination of this License. 12. Attorneys’ Fees. In any action to enforce the terms of this License or seeking damages relating thereto, the prevailing party shall be entitled to recover its costs and expenses, including, without limitation, reasonable attorneys' fees and costs incurred in connection with such action, including any appeal of such action. This section shall survive the termination of this License. 13. Miscellaneous. If any provision of this License is held to be unenforceable, such provision shall be reformed only to the extent necessary to make it enforceable. 14. Definition of "You" in This License. "You" throughout this License, whether in upper or lower case, means an individual or a legal entity exercising rights under, and complying with all of the terms of, this License. For legal entities, "You" includes any entity that controls, is controlled by, or is under common control with you. For purposes of this definition, "control" means (i) the power, direct or indirect, to cause the direction or management of such entity, whether by contract or otherwise, or (ii) ownership of fifty percent (50%) or more of the outstanding shares, or (iii) beneficial ownership of such entity. 15. Right to Use. You may use the Original Work in all ways not otherwise restricted or conditioned by this License or by law, and Licensor promises not to interfere with or be responsible for such uses by You. 16. Modification of This License. This License is Copyright © 2005 Lawrence Rosen. Permission is granted to copy, distribute, or communicate this License without modification. Nothing in this License permits You to modify this License as applied to the Original Work or to Derivative Works. However, You may modify the text of this License and copy, distribute or communicate your modified version (the "Modified License") and apply it to other original works of authorship subject to the following conditions: (i) You may not indicate in any way that your Modified License is the "Academic Free License" or "AFL" and you may not use those names in the name of your Modified License; (ii) You must replace the notice specified in the first paragraph above with the notice "Licensed under " or with a notice of your own that is not confusingly similar to the notice in this License; and (iii) You may not claim that your original works are open source software unless your Modified License has been approved by Open Source Initiative (OSI) and You comply with its license review and certification process. [3]. BSD license Copyright (c) 2004-2008, Tango contributors All rights reserved. * Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ieee754-0.7.8/NEWS000644 000765 000024 00000003636 12643600076 013676 0ustar00ptrckstaff000000 000000 Changes in 0.7.8: * Alain O'Dea fixed broken illumos build. * Simplified endianness detection in C code. Changes in 0.7.7: * Johan Kiviniemi added tests for minNormal, maxFinite, epsilon, maxNaNPayload. Changes in 0.7.6: * Fix broken windows build. Changes in 0.7.5: * Added more robust check for endianness (related to issue #5, reported by @juricast). Changes in 0.7.4: * Add C implementation of copysign, copysignf * Remove libm dependency * Anders Kaseorg fixed documentation for epsilon. Changes in 0.7.3: * Bugfix from Björn Buckwalter: any two negative values were aproxEqIEEE Changes in 0.7.2: * Fix aliasing warnings in C code Changes in 0.7.1: * Rename package from "ieee" to "ieee754" Changes in 0.7: * Add IEEE type class with instances for Double, Float, CDouble, and CFloat * Add functions for getting/setting NaN payloads * Add succIEEE/predIEEE for advancing up and down the IEEE number line (ported from Tango's nextUp and nextDown) * Add bisectIEEE for midpoints of two numbers on the IEEE number line (ported from Tango's ieeeMean) * Add identicalIEEE for exact (bitwise) equality of IEEE numbers * Add copySign for setting the sign bit of an IEEE number * Add sameSignificandBits for seeing how many significand bits of two IEEE numbers agree, ported from Tango's feqrel * Add nan, infinity, maxFinite, minNormal constants for IEEE numbers * Add maxNum and minNum * Rename maxF and minF to maxNaN and minNaN * Switch to a simpler "~==" comparison for complex numbers * Make "~==" comparison use sameSignificandBits for IEEE types * Make "===" comparison use bitwise equality for IEEE types * Remove old "eqRel" comparisons. * Remove old epsilon' and delta constants * Remove (RealFloat a) => AEq (Complex a) instance in favor of explicit instances for Complex {Double,Float,CDouble,CFloat} Changes in 0.6.1: * Remove AEq instance for CLDouble (thanks to Bjorn Buckwalter) ieee754-0.7.8/Numeric/000755 000765 000024 00000000000 12643600076 014571 5ustar00ptrckstaff000000 000000 ieee754-0.7.8/Setup.lhs000644 000765 000024 00000000143 12643600076 014775 0ustar00ptrckstaff000000 000000 #!/usr/bin/env runhaskell > import Distribution.Simple > import System.Cmd > > main = defaultMain >ieee754-0.7.8/tests/000755 000765 000024 00000000000 12643600076 014331 5ustar00ptrckstaff000000 000000 ieee754-0.7.8/tests/Makefile000644 000765 000024 00000000710 12643600076 015767 0ustar00ptrckstaff000000 000000 all: ghc -O ../cbits/double.c ../cbits/float.c -lm \ -i. -i.. Tests.hs --make -o test-ieee ./test-ieee hpc: ghc -fforce-recomp ../cbits/double.c ../cbits/float.c -lm \ -i. -i.. -fhpc --make Tests.hs -o test-ieee rm -f test-ieee.tix ./test-ieee hpc markup test-ieee clean: find ../lib . -name '*.hi' | xargs rm -f find ../lib . -name '*.o' | xargs rm -f find . -name '*.html' | xargs rm -f rm -f test-ieee test-ieee.tix rm -rf .hpc ieee754-0.7.8/tests/Tests.hs000644 000765 000024 00000060640 12643600076 015775 0ustar00ptrckstaff000000 000000 module Main where import Control.Monad( forM_, unless ) import Test.Framework import Test.Framework.Providers.HUnit import Test.HUnit import Data.AEq import Numeric.IEEE type D = Double type F = Float infix 1 @?~=, @?== (@?~=) actual expected = unless (actual ~== expected) (assertFailure msg) where msg = "expected: " ++ show expected ++ "\n but got: " ++ show actual (@?==) actual expected = unless (actual === expected) (assertFailure msg) where msg = "expected: " ++ show expected ++ "\n but got: " ++ show actual test_maxNum = testGroup "maxNum" [ testCase "D1" test_maxNum_D1 , testCase "D2" test_maxNum_D2 , testCase "D3" test_maxNum_D3 , testCase "D4" test_maxNum_D4 , testCase "D5" test_maxNum_D5 , testCase "F1" test_maxNum_F1 , testCase "F2" test_maxNum_F2 , testCase "F3" test_maxNum_F3 , testCase "F4" test_maxNum_F4 , testCase "F5" test_maxNum_F5 ] test_maxNum_D1 = maxNum nan 1 @?= (1 :: D) test_maxNum_D2 = maxNum 1 nan @?= (1 :: D) test_maxNum_D3 = maxNum 1 0 @?= (1 :: D) test_maxNum_D4 = maxNum 0 1 @?= (1 :: D) test_maxNum_D5 = maxNum (nanWithPayload 1) (nanWithPayload 2) @?== (nanWithPayload 1 :: D) test_maxNum_F1 = maxNum nan 1 @?= (1 :: F) test_maxNum_F2 = maxNum 1 nan @?= (1 :: F) test_maxNum_F3 = maxNum 1 0 @?= (1 :: F) test_maxNum_F4 = maxNum 0 1 @?= (1 :: F) test_maxNum_F5 = maxNum (nanWithPayload 1) (nanWithPayload 2) @?== (nanWithPayload 1 :: F) test_minNum = testGroup "minNum" [ testCase "D1" test_minNum_D1 , testCase "D2" test_minNum_D2 , testCase "D3" test_minNum_D3 , testCase "D4" test_minNum_D4 , testCase "D5" test_minNum_D5 , testCase "F1" test_minNum_F1 , testCase "F2" test_minNum_F2 , testCase "F3" test_minNum_F3 , testCase "F4" test_minNum_F4 , testCase "F5" test_minNum_F5 ] test_minNum_D1 = minNum nan 1 @?= (1 :: D) test_minNum_D2 = minNum 1 nan @?= (1 :: D) test_minNum_D3 = minNum 1 2 @?= (1 :: D) test_minNum_D4 = minNum 2 1 @?= (1 :: D) test_minNum_D5 = minNum (nanWithPayload 1) (nanWithPayload 2) @?== (nanWithPayload 1 :: D) test_minNum_F1 = minNum nan 1 @?= (1 :: F) test_minNum_F2 = minNum 1 nan @?= (1 :: F) test_minNum_F3 = minNum 1 2 @?= (1 :: F) test_minNum_F4 = minNum 2 1 @?= (1 :: F) test_minNum_F5 = minNum (nanWithPayload 1) (nanWithPayload 2) @?== (nanWithPayload 1 :: F) test_maxNaN = testGroup "maxNaN" [ testCase "D1" test_maxNaN_D1 , testCase "D2" test_maxNaN_D2 , testCase "D3" test_maxNaN_D3 , testCase "D4" test_maxNaN_D4 , testCase "D5" test_maxNaN_D5 , testCase "F1" test_maxNaN_F1 , testCase "F2" test_maxNaN_F2 , testCase "F3" test_maxNaN_F3 , testCase "F4" test_maxNaN_F4 , testCase "F5" test_maxNaN_F5 ] test_maxNaN_D1 = maxNaN nan 1 @?== (nan :: D) test_maxNaN_D2 = maxNaN 1 nan @?== (nan :: D) test_maxNaN_D3 = maxNaN 1 0 @?== (1 :: D) test_maxNaN_D4 = maxNaN 0 1 @?== (1 :: D) test_maxNaN_D5 = maxNaN (nanWithPayload 1) (nanWithPayload 2) @?== (nanWithPayload 1 :: D) test_maxNaN_F1 = maxNaN nan 1 @?== (nan :: F) test_maxNaN_F2 = maxNaN 1 nan @?== (nan :: F) test_maxNaN_F3 = maxNaN 1 0 @?== (1 :: F) test_maxNaN_F4 = maxNaN 0 1 @?== (1 :: F) test_maxNaN_F5 = maxNaN (nanWithPayload 1) (nanWithPayload 2) @?== (nanWithPayload 1 :: F) test_minNaN = testGroup "minNaN" [ testCase "D1" test_minNaN_D1 , testCase "D2" test_minNaN_D2 , testCase "D3" test_minNaN_D3 , testCase "D4" test_minNaN_D4 , testCase "D5" test_minNaN_D5 , testCase "F1" test_minNaN_F1 , testCase "F2" test_minNaN_F2 , testCase "F3" test_minNaN_F3 , testCase "F4" test_minNaN_F4 , testCase "F5" test_minNaN_F5 ] test_minNaN_D1 = minNaN nan 1 @?== (nan :: D) test_minNaN_D2 = minNaN 1 nan @?== (nan :: D) test_minNaN_D3 = minNaN 1 2 @?== (1 :: D) test_minNaN_D4 = minNaN 2 1 @?== (1 :: D) test_minNaN_D5 = minNaN (nanWithPayload 1) (nanWithPayload 2) @?== (nanWithPayload 1 :: D) test_minNaN_F1 = minNaN nan 1 @?== (nan :: F) test_minNaN_F2 = minNaN 1 nan @?== (nan :: F) test_minNaN_F3 = minNaN 1 2 @?== (1 :: F) test_minNaN_F4 = minNaN 2 1 @?== (1 :: F) test_minNaN_F5 = minNaN (nanWithPayload 1) (nanWithPayload 2) @?== (nanWithPayload 1 :: F) test_nan = testGroup "nan" $ [ testCase "D" test_nan_D , testCase "F" test_nan_F ] test_nan_D = isNaN (nan :: D) @?= True test_nan_F = isNaN (nan :: F) @?= True test_infinity = testGroup "infinity" [ testCase "D1" test_infinity_D1 , testCase "D2" test_infinity_D2 , testCase "F1" test_infinity_F1 , testCase "F2" test_infinity_F2 ] test_infinity_D1 = isInfinite (infinity :: D) @?= True test_infinity_D2 = infinity > (0 :: D) @?= True test_infinity_F1 = isInfinite (infinity :: F) @?= True test_infinity_F2 = infinity > (0 :: F) @?= True test_minNormal = testGroup "minNormal" [ testCase "D" (go (minNormal :: D)) , testCase "F" (go (minNormal :: F)) ] where go n = let (e,_) = floatRange (undefined `asTypeOf` n) in n @?= encodeFloat 1 (e-1) test_maxFinite = testGroup "maxFinite" [ testCase "D" (go (maxFinite :: D)) , testCase "F" (go (maxFinite :: F)) ] where go n = let r = floatRadix (undefined `asTypeOf` n) d = floatDigits (undefined `asTypeOf` n) (_,e) = floatRange (undefined `asTypeOf` n) in n @?= encodeFloat (r^d-1) (e-d) test_epsilon = testGroup "epsilon" [ testCase "D" (go (epsilon :: D)) , testCase "F" (go (epsilon :: F)) ] where go n = let d = floatDigits (undefined `asTypeOf` n) in n @?= encodeFloat 1 (1-d) -- succIEEE and predIEEE tests ported from tango/math/IEEE.d test_succIEEE = testGroup "succIEEE" [ testCase "nan D" test_succIEEE_nan_D , testCase "neg D1" test_succIEEE_neg_D1 , testCase "neg D2" test_succIEEE_neg_D2 , testCase "neg D3" test_succIEEE_neg_D3 , testCase "neg denorm D1" test_succIEEE_neg_denorm_D1 , testCase "neg denorm D2" test_succIEEE_neg_denorm_D2 , testCase "neg denrom D3" test_succIEEE_neg_denorm_D3 , testCase "zero D1" test_succIEEE_zero_D1 , testCase "zero D2" test_succIEEE_zero_D2 , testCase "pos denorm D1" test_succIEEE_pos_denorm_D1 , testCase "pos denorm D2" test_succIEEE_pos_denorm_D2 , testCase "pos D1" test_succIEEE_pos_D1 , testCase "pos D2" test_succIEEE_pos_D2 , testCase "pos D3" test_succIEEE_pos_D3 , testCase "nan F" test_succIEEE_nan_F , testCase "neg F1" test_succIEEE_neg_F1 , testCase "neg F2" test_succIEEE_neg_F2 , testCase "neg F3" test_succIEEE_neg_F3 , testCase "neg denorm F1" test_succIEEE_neg_denorm_F1 , testCase "neg denorm F2" test_succIEEE_neg_denorm_F2 , testCase "neg denrom F3" test_succIEEE_neg_denorm_F3 , testCase "zero F1" test_succIEEE_zero_F1 , testCase "zero F2" test_succIEEE_zero_F2 , testCase "pos denorm F1" test_succIEEE_pos_denorm_F1 , testCase "pos denorm F2" test_succIEEE_pos_denorm_F2 , testCase "pos F1" test_succIEEE_pos_F1 , testCase "pos F2" test_succIEEE_pos_F2 , testCase "pos F3" test_succIEEE_pos_F3 ] test_succIEEE_nan_D = isNaN (succIEEE (nan :: D)) @?= True test_succIEEE_neg_D1 = succIEEE (-infinity) @?= (-maxFinite :: D) test_succIEEE_neg_D2 = succIEEE (-1 - epsilon) @?= (-1 :: D) test_succIEEE_neg_D3 = succIEEE (-2) @?= (-2 + epsilon :: D) test_succIEEE_neg_denorm_D1 = succIEEE (-minNormal) @?= (-minNormal*(1 - epsilon) :: D) test_succIEEE_neg_denorm_D2 = succIEEE (-minNormal*(1-epsilon)) @?= (-minNormal*(1-2*epsilon) :: D) test_succIEEE_neg_denorm_D3 = isNegativeZero (succIEEE (-minNormal*epsilon :: D)) @?= True test_succIEEE_zero_D1 = succIEEE (-0) @?= (minNormal * epsilon :: D) test_succIEEE_zero_D2 = succIEEE 0 @?= (minNormal * epsilon :: D) test_succIEEE_pos_denorm_D1 = succIEEE (minNormal*(1-epsilon)) @?= (minNormal :: D) test_succIEEE_pos_denorm_D2 = succIEEE (minNormal) @?= (minNormal*(1+epsilon) :: D) test_succIEEE_pos_D1 = succIEEE 1 @?= (1 + epsilon :: D) test_succIEEE_pos_D2 = succIEEE (2 - epsilon) @?= (2 :: D) test_succIEEE_pos_D3 = succIEEE maxFinite @?= (infinity :: D) test_succIEEE_nan_F = isNaN (succIEEE (nan :: F)) @?= True test_succIEEE_neg_F1 = succIEEE (-infinity) @?= (-maxFinite :: F) test_succIEEE_neg_F2 = succIEEE (-1 - epsilon) @?= (-1 :: F) test_succIEEE_neg_F3 = succIEEE (-2) @?= (-2 + epsilon :: F) test_succIEEE_neg_denorm_F1 = succIEEE (-minNormal) @?= (-minNormal*(1 - epsilon) :: F) test_succIEEE_neg_denorm_F2 = succIEEE (-minNormal*(1-epsilon)) @?= (-minNormal*(1-2*epsilon) :: F) test_succIEEE_neg_denorm_F3 = isNegativeZero (succIEEE (-minNormal*epsilon :: F)) @?= True test_succIEEE_zero_F1 = succIEEE (-0) @?= (minNormal * epsilon :: F) test_succIEEE_zero_F2 = succIEEE 0 @?= (minNormal * epsilon :: F) test_succIEEE_pos_denorm_F1 = succIEEE (minNormal*(1-epsilon)) @?= (minNormal :: F) test_succIEEE_pos_denorm_F2 = succIEEE (minNormal) @?= (minNormal*(1+epsilon) :: F) test_succIEEE_pos_F1 = succIEEE 1 @?= (1 + epsilon :: F) test_succIEEE_pos_F2 = succIEEE (2 - epsilon) @?= (2 :: F) test_succIEEE_pos_F3 = succIEEE maxFinite @?= (infinity :: F) test_predIEEE = testGroup "predIEEE" [ testCase "D" test_predIEEE_D , testCase "F" test_predIEEE_F ] test_predIEEE_D = predIEEE (1 + epsilon) @?= (1 :: D) test_predIEEE_F = predIEEE (1 + epsilon) @?= (1 :: F) test_bisectIEEE = testGroup "bisectIEEE" [ testCase "D1" test_bisectIEEE_D1 , testCase "D2" test_bisectIEEE_D2 , testCase "D3" test_bisectIEEE_D3 , testCase "D4" test_bisectIEEE_D4 , testCase "D5" test_bisectIEEE_D5 , testCase "D6" test_bisectIEEE_D6 , testCase "D7" test_bisectIEEE_D7 , testCase "D8" test_bisectIEEE_D8 , testCase "D9" test_bisectIEEE_D9 , testCase "F1" test_bisectIEEE_F1 , testCase "F2" test_bisectIEEE_F2 , testCase "F3" test_bisectIEEE_F3 , testCase "F4" test_bisectIEEE_F4 , testCase "F5" test_bisectIEEE_F5 , testCase "F6" test_bisectIEEE_F6 , testCase "F7" test_bisectIEEE_F7 , testCase "F8" test_bisectIEEE_F8 , testCase "F9" test_bisectIEEE_F9 ] test_bisectIEEE_D1 = bisectIEEE (-0) (-1e-20) < (0 :: D) @?= True test_bisectIEEE_D2 = bisectIEEE (0) (1e-20) > (0 :: D) @?= True test_bisectIEEE_D3 = bisectIEEE 1 4 @?= (2 :: D) test_bisectIEEE_D4 = bisectIEEE (2*1.013) (8*1.013) @?= (4*1.013 :: D) test_bisectIEEE_D5 = bisectIEEE (-1) (-4) @?= (-2 :: D) test_bisectIEEE_D6 = bisectIEEE (-1) (-2) @?= (-1.5 :: D) test_bisectIEEE_D7 = bisectIEEE (-1*(1+8*epsilon)) (-2*(1+8*epsilon)) @?= (-1.5*(1+5*epsilon) :: D) test_bisectIEEE_D8 = bisectIEEE (encodeFloat 0x100000 60) (encodeFloat 0x100000 (-10)) @?= (encodeFloat 0x100000 25 :: D) test_bisectIEEE_D9 = bisectIEEE 0 infinity @?= (1.5 :: D) test_bisectIEEE_F1 = bisectIEEE (-0) (-1e-20) < (0 :: F) @?= True test_bisectIEEE_F2 = bisectIEEE (0) (1e-20) > (0 :: F) @?= True test_bisectIEEE_F3 = bisectIEEE 1 4 @?= (2 :: F) test_bisectIEEE_F4 = bisectIEEE (2*1.013) (8*1.013) @?= (4*1.013 :: F) test_bisectIEEE_F5 = bisectIEEE (-1) (-4) @?= (-2 :: F) test_bisectIEEE_F6 = bisectIEEE (-1) (-2) @?= (-1.5 :: F) test_bisectIEEE_F7 = bisectIEEE (-1*(1+8*epsilon)) (-2*(1+8*epsilon)) @?= (-1.5*(1+5*epsilon) :: F) test_bisectIEEE_F8 = bisectIEEE (encodeFloat 0x100000 60) (encodeFloat 0x100000 (-10)) @?= (encodeFloat 0x100000 25 :: F) test_bisectIEEE_F9 = bisectIEEE 0 infinity @?= (1.5 :: F) test_sameSignificandBits = testGroup "sameSignificandBits" $ [ testCase "exact D1" test_sameSignificandBits_exact_D1 , testCase "exact D2" test_sameSignificandBits_exact_D2 , testCase "exact D3" test_sameSignificandBits_exact_D3 , testCase "exact D4" test_sameSignificandBits_exact_D4 , testCase "fewbits D1" test_sameSignificandBits_fewbits_D1 , testCase "fewbits D2" test_sameSignificandBits_fewbits_D2 , testCase "fewbits D3" test_sameSignificandBits_fewbits_D3 , testCase "fewbits D4" test_sameSignificandBits_fewbits_D4 , testCase "fewbits D5" test_sameSignificandBits_fewbits_D5 , testCase "fewbits D6" test_sameSignificandBits_fewbits_D6 , testCase "fewbits D7" test_sameSignificandBits_fewbits_D7 , testCase "close D1" test_sameSignificandBits_close_D1 , testCase "close D2" test_sameSignificandBits_close_D2 , testCase "close D3" test_sameSignificandBits_close_D3 , testCase "close D4" test_sameSignificandBits_close_D4 , testCase "close D5" test_sameSignificandBits_close_D5 , testCase "2factors D1" test_sameSignificandBits_2factors_D1 , testCase "2factors D2" test_sameSignificandBits_2factors_D2 , testCase "2factors D3" test_sameSignificandBits_2factors_D3 , testCase "2factors D4" test_sameSignificandBits_2factors_D4 , testCase "extreme D1" test_sameSignificandBits_extreme_D1 , testCase "extreme D2" test_sameSignificandBits_extreme_D2 , testCase "extreme D3" test_sameSignificandBits_extreme_D3 , testCase "extreme D4" test_sameSignificandBits_extreme_D4 , testCase "extreme D5" test_sameSignificandBits_extreme_D5 , testCase "extreme D6" test_sameSignificandBits_extreme_D6 , testCase "exact F1" test_sameSignificandBits_exact_F1 , testCase "exact F2" test_sameSignificandBits_exact_F2 , testCase "exact F3" test_sameSignificandBits_exact_F3 , testCase "exact F4" test_sameSignificandBits_exact_F4 , testCase "fewbits F1" test_sameSignificandBits_fewbits_F1 , testCase "fewbits F2" test_sameSignificandBits_fewbits_F2 , testCase "fewbits F3" test_sameSignificandBits_fewbits_F3 , testCase "fewbits F4" test_sameSignificandBits_fewbits_F4 , testCase "fewbits F5" test_sameSignificandBits_fewbits_F5 , testCase "fewbits F6" test_sameSignificandBits_fewbits_F6 , testCase "fewbits F7" test_sameSignificandBits_fewbits_F7 , testCase "close F1" test_sameSignificandBits_close_F1 , testCase "close F2" test_sameSignificandBits_close_F2 , testCase "close F3" test_sameSignificandBits_close_F3 , testCase "close F4" test_sameSignificandBits_close_F4 , testCase "close F5" test_sameSignificandBits_close_F5 , testCase "2factors F1" test_sameSignificandBits_2factors_F1 , testCase "2factors F2" test_sameSignificandBits_2factors_F2 , testCase "2factors F3" test_sameSignificandBits_2factors_F3 , testCase "2factors F4" test_sameSignificandBits_2factors_F4 , testCase "extreme F1" test_sameSignificandBits_extreme_F1 , testCase "extreme F2" test_sameSignificandBits_extreme_F2 , testCase "extreme F3" test_sameSignificandBits_extreme_F3 , testCase "extreme F4" test_sameSignificandBits_extreme_F4 , testCase "extreme F5" test_sameSignificandBits_extreme_F5 , testCase "extreme F6" test_sameSignificandBits_extreme_F6 ] test_sameSignificandBits_exact_D1 = sameSignificandBits (maxFinite :: D) maxFinite @?= floatDigits (undefined :: D) test_sameSignificandBits_exact_D2 = sameSignificandBits (0 :: D) 0 @?= floatDigits (undefined :: D) test_sameSignificandBits_exact_D3 = sameSignificandBits (7.1824 :: D) 7.1824 @?= floatDigits (undefined :: D) test_sameSignificandBits_exact_D4 = sameSignificandBits (infinity :: D) infinity @?= floatDigits (undefined :: D) test_sameSignificandBits_fewbits_D1 = forM_ [ 0..mantDig-1 ] $ \i -> sameSignificandBits (1 + 2^^i * epsilon) (1 :: D) @?= mantDig - i - 1 where mantDig = floatDigits (undefined :: D) test_sameSignificandBits_fewbits_D2 = forM_ [ 0..mantDig-3 ] $ \i -> sameSignificandBits (1 - 2^^i * epsilon) (1 :: D) @?= mantDig - i - 1 where mantDig = floatDigits (undefined :: D) test_sameSignificandBits_fewbits_D3 = forM_ [ 0..mantDig-1 ] $ \i -> sameSignificandBits (1 :: D) (1 + (2^^i - 1) * epsilon) @?= mantDig - i where mantDig = floatDigits (undefined :: D) test_sameSignificandBits_fewbits_D4 = sameSignificandBits (1.5 + epsilon) (1.5 :: D) @?= floatDigits (undefined :: D) - 1 test_sameSignificandBits_fewbits_D5 = sameSignificandBits (1.5 - epsilon) (1.5 :: D) @?= floatDigits (undefined :: D) - 1 test_sameSignificandBits_fewbits_D6 = sameSignificandBits (1.5 - epsilon) (1.5 + epsilon :: D) @?= floatDigits (undefined :: D) - 2 test_sameSignificandBits_fewbits_D7 = sameSignificandBits (minNormal / 8) (minNormal / 17 :: D) @?= 3 test_sameSignificandBits_close_D1 = sameSignificandBits (encodeFloat 0x1B0000 84) (encodeFloat 0x1B8000 84 :: D) @?= 5 test_sameSignificandBits_close_D2 = sameSignificandBits (encodeFloat 0x180000 10) (encodeFloat 0x1C0000 10 :: D) @?= 2 test_sameSignificandBits_close_D3 = sameSignificandBits (1.5 * (1 - epsilon)) (1 :: D) @?= 2 test_sameSignificandBits_close_D4 = sameSignificandBits 1.5 (1 :: D) @?= 1 test_sameSignificandBits_close_D5 = sameSignificandBits (2 * (1 - epsilon)) (1 :: D) @?= 1 test_sameSignificandBits_2factors_D1 = sameSignificandBits maxFinite (infinity :: D) @?= 0 test_sameSignificandBits_2factors_D2 = sameSignificandBits (2 * (1 - epsilon)) (1 :: D) @?= 1 test_sameSignificandBits_2factors_D3 = sameSignificandBits 1 (2 :: D) @?= 0 test_sameSignificandBits_2factors_D4 = sameSignificandBits 4 (1 :: D) @?= 0 test_sameSignificandBits_extreme_D1 = sameSignificandBits nan (nan :: D) @?= 0 test_sameSignificandBits_extreme_D2 = sameSignificandBits 0 (-nan :: D) @?= 0 test_sameSignificandBits_extreme_D3 = sameSignificandBits nan (infinity :: D) @?= 0 test_sameSignificandBits_extreme_D4 = sameSignificandBits infinity (-infinity :: D) @?= 0 test_sameSignificandBits_extreme_D5 = sameSignificandBits (-maxFinite) (infinity :: D) @?= 0 test_sameSignificandBits_extreme_D6 = sameSignificandBits (maxFinite) (-maxFinite :: D) @?= 0 test_sameSignificandBits_exact_F1 = sameSignificandBits (maxFinite :: F) maxFinite @?= floatDigits (undefined :: F) test_sameSignificandBits_exact_F2 = sameSignificandBits (0 :: F) 0 @?= floatDigits (undefined :: F) test_sameSignificandBits_exact_F3 = sameSignificandBits (7.1824 :: F) 7.1824 @?= floatDigits (undefined :: F) test_sameSignificandBits_exact_F4 = sameSignificandBits (infinity :: F) infinity @?= floatDigits (undefined :: F) test_sameSignificandBits_fewbits_F1 = forM_ [ 0..mantFig-1 ] $ \i -> sameSignificandBits (1 + 2^^i * epsilon) (1 :: F) @?= mantFig - i - 1 where mantFig = floatDigits (undefined :: F) test_sameSignificandBits_fewbits_F2 = forM_ [ 0..mantFig-3 ] $ \i -> sameSignificandBits (1 - 2^^i * epsilon) (1 :: F) @?= mantFig - i - 1 where mantFig = floatDigits (undefined :: F) test_sameSignificandBits_fewbits_F3 = forM_ [ 0..mantFig-1 ] $ \i -> sameSignificandBits (1 :: F) (1 + (2^^i - 1) * epsilon) @?= mantFig - i where mantFig = floatDigits (undefined :: F) test_sameSignificandBits_fewbits_F4 = sameSignificandBits (1.5 + epsilon) (1.5 :: F) @?= floatDigits (undefined :: F) - 1 test_sameSignificandBits_fewbits_F5 = sameSignificandBits (1.5 - epsilon) (1.5 :: F) @?= floatDigits (undefined :: F) - 1 test_sameSignificandBits_fewbits_F6 = sameSignificandBits (1.5 - epsilon) (1.5 + epsilon :: F) @?= floatDigits (undefined :: F) - 2 test_sameSignificandBits_fewbits_F7 = sameSignificandBits (minNormal / 8) (minNormal / 17 :: F) @?= 3 test_sameSignificandBits_close_F1 = sameSignificandBits (encodeFloat 0x1B0000 84) (encodeFloat 0x1B8000 84 :: F) @?= 5 test_sameSignificandBits_close_F2 = sameSignificandBits (encodeFloat 0x180000 10) (encodeFloat 0x1C0000 10 :: F) @?= 2 test_sameSignificandBits_close_F3 = sameSignificandBits (1.5 * (1 - epsilon)) (1 :: F) @?= 2 test_sameSignificandBits_close_F4 = sameSignificandBits 1.5 (1 :: F) @?= 1 test_sameSignificandBits_close_F5 = sameSignificandBits (2 * (1 - epsilon)) (1 :: F) @?= 1 test_sameSignificandBits_2factors_F1 = sameSignificandBits maxFinite (infinity :: F) @?= 0 test_sameSignificandBits_2factors_F2 = sameSignificandBits (2 * (1 - epsilon)) (1 :: F) @?= 1 test_sameSignificandBits_2factors_F3 = sameSignificandBits 1 (2 :: F) @?= 0 test_sameSignificandBits_2factors_F4 = sameSignificandBits 4 (1 :: F) @?= 0 test_sameSignificandBits_extreme_F1 = sameSignificandBits nan (nan :: F) @?= 0 test_sameSignificandBits_extreme_F2 = sameSignificandBits 0 (-nan :: F) @?= 0 test_sameSignificandBits_extreme_F3 = sameSignificandBits nan (infinity :: F) @?= 0 test_sameSignificandBits_extreme_F4 = sameSignificandBits infinity (-infinity :: F) @?= 0 test_sameSignificandBits_extreme_F5 = sameSignificandBits (-maxFinite) (infinity :: F) @?= 0 test_sameSignificandBits_extreme_F6 = sameSignificandBits (maxFinite) (-maxFinite :: F) @?= 0 test_nanWithPayload = testGroup "nanWithPayload" [ testCase "D1" test_nanWithPayload_D1 , testCase "D2" test_nanWithPayload_D2 , testCase "F1" test_nanWithPayload_F1 , testCase "F2" test_nanWithPayload_F2 ] test_nanWithPayload_D1 = isNaN (nanWithPayload 1 :: D) @?= True test_nanWithPayload_D2 = isNaN (nanWithPayload maxPayload :: D) @?= True where maxPayload = maxNaNPayload (undefined :: D) test_nanWithPayload_F1 = isNaN (nanWithPayload 1 :: F) @?= True test_nanWithPayload_F2 = isNaN (nanWithPayload maxPayload :: F) @?= True where maxPayload = maxNaNPayload (undefined :: F) test_maxNaNPayload = testGroup "maxNaNPayload" [ testCase "D" (go (undefined :: D)) , testCase "F" (go (undefined :: F)) ] where go n = let b = floatRadix (undefined `asTypeOf` n) d = floatDigits (undefined `asTypeOf` n) in maxNaNPayload n @?= fromIntegral (b^(d-2)-1) test_nanPayload = testGroup "nanPayload" [ testCase "D1" test_nanPayload_D1 , testCase "D2" test_nanPayload_D2 , testCase "D3" test_nanPayload_D3 , testCase "F1" test_nanPayload_F1 , testCase "F2" test_nanPayload_F2 , testCase "F3" test_nanPayload_F3 ] test_nanPayload_D1 = nanPayload (nanWithPayload 1 :: D) @?= 1 test_nanPayload_D2 = nanPayload (nanWithPayload maxPayload :: D) @?= maxPayload where maxPayload = maxNaNPayload (undefined :: D) test_nanPayload_D3 = nanPayload (nanWithPayload (maxPayload + 1) :: D) @?= 0 where maxPayload = maxNaNPayload (undefined :: D) test_nanPayload_F1 = nanPayload (nanWithPayload 1 :: F) @?= 1 test_nanPayload_F2 = nanPayload (nanWithPayload maxPayload :: F) @?= maxPayload where maxPayload = maxNaNPayload (undefined :: F) test_nanPayload_F3 = nanPayload (nanWithPayload (maxPayload + 1) :: F) @?= 0 where maxPayload = maxNaNPayload (undefined :: F) test_copySign = testGroup "copySign" [ testCase "D1" test_copySign_D1 , testCase "D2" test_copySign_D2 , testCase "D3" test_copySign_D3 , testCase "D4" test_copySign_D4 , testCase "D5" test_copySign_D5 , testCase "D6" test_copySign_D6 , testCase "F1" test_copySign_F1 , testCase "F2" test_copySign_F2 , testCase "F3" test_copySign_F3 , testCase "F4" test_copySign_F4 , testCase "F5" test_copySign_F5 , testCase "F6" test_copySign_F6 ] test_copySign_D1 = copySign 0.9 (-1.2) @?= (-0.9 :: D) test_copySign_D2 = copySign 0.9 (1.2) @?= (0.9 :: D) test_copySign_D3 = copySign (-0.9 )(1.2) @?= (0.9 :: D) test_copySign_D4 = copySign (-0.9) (-1.2) @?= (-0.9 :: D) test_copySign_D5 = copySign 1 (copySign nan 1) @?= (1 :: D) test_copySign_D6 = copySign 1 (copySign nan (-1)) @?= (-1 :: D) test_copySign_F1 = copySign 0.9 (-1.2) @?= (-0.9 :: F) test_copySign_F2 = copySign 0.9 (1.2) @?= (0.9 :: F) test_copySign_F3 = copySign (-0.9 )(1.2) @?= (0.9 :: F) test_copySign_F4 = copySign (-0.9) (-1.2) @?= (-0.9 :: F) test_copySign_F5 = copySign 1 (copySign nan 1) @?= (1 :: F) test_copySign_F6 = copySign 1 (copySign nan (-1)) @?= (-1 :: F) test_IEEE = testGroup "IEEE" [ test_infinity , test_minNormal , test_maxFinite , test_epsilon , test_copySign , test_succIEEE , test_predIEEE , test_bisectIEEE , test_sameSignificandBits , test_maxNum , test_minNum , test_maxNaN , test_minNaN , test_nan , test_nanWithPayload , test_maxNaNPayload , test_nanPayload ] main :: IO () main = defaultMain [ test_IEEE ] ieee754-0.7.8/Numeric/IEEE.hs000644 000765 000024 00000020711 12643600076 015635 0ustar00ptrckstaff000000 000000 {-# LANGUAGE ForeignFunctionInterface #-} ----------------------------------------------------------------------------- -- | -- Module : Numeric.IEEE -- Copyright : Copyright (c) 2010, Patrick Perry -- License : BSD3 -- Maintainer : Patrick Perry -- Stability : experimental -- -- Operations on IEEE floating point numbers. -- module Numeric.IEEE ( -- * IEEE type class IEEE(..), -- * NaN-aware minimum and maximum minNum, maxNum, minNaN, maxNaN, ) where import Data.Word import Foreign.C.Types( CFloat, CDouble ) -- | IEEE floating point types. class (RealFloat a) => IEEE a where -- | Infinity value. infinity :: a -- | The smallest representable positive normalized value. minNormal :: a -- | The largest representable finite value. maxFinite :: a -- | The smallest positive value @x@ such that @1 + x@ is representable. epsilon :: a -- | @copySign x y@ returns @x@ with its sign changed to @y@'s. copySign :: a -> a -> a -- | Return 'True' if two values are /exactly/ (bitwise) equal. identicalIEEE :: a -> a -> Bool -- | Return the next largest IEEE value (@Infinity@ and @NaN@ are -- unchanged). succIEEE :: a -> a -- | Return the next smallest IEEE value (@-Infinity@ and @NaN@ are -- unchanged). predIEEE :: a -> a -- | Given two values with the same sign, return the value halfway -- between them on the IEEE number line. If the signs of the values -- differ or either is @NaN@, the value is undefined. bisectIEEE :: a -> a -> a -- | The number of significand bits which are equal in the two arguments -- (equivalent to @feqrel@ from the Tango Math library). The result is -- between @0@ and @'floatDigits'@. sameSignificandBits :: a -> a -> Int -- | Default @NaN@ value. nan :: a -- | Quiet @NaN@ value with a positive integer payload. Payload must be -- less than 'maxNaNPayload'. Beware that while some platforms allow -- using @0@ as a payload, this behavior is not portable. nanWithPayload :: Word64 -> a -- | Maximum @NaN@ payload for type @a@. maxNaNPayload :: a -> Word64 -- | The payload stored in a @NaN@ value. Undefined if the argument -- is not @NaN@. nanPayload :: a -> Word64 -- | Return the maximum of two values; if one value is @NaN@, return the -- other. Prefer the first if both values are @NaN@. maxNum :: (RealFloat a) => a -> a -> a maxNum x y | x >= y || isNaN y = x | otherwise = y {-# INLINE maxNum #-} -- | Return the minimum of two values; if one value is @NaN@, return the -- other. Prefer the first if both values are @NaN@. minNum :: (RealFloat a) => a -> a -> a minNum x y | x <= y || isNaN y = x | otherwise = y {-# INLINE minNum #-} -- | Return the maximum of two values; if one value is @NaN@, return it. -- Prefer the first if both values are @NaN@. maxNaN :: (RealFloat a) => a -> a -> a maxNaN x y | x >= y || isNaN x = x | otherwise = y {-# INLINE maxNaN #-} -- | Return the minimum of two values; if one value is @NaN@, return it. -- Prefer the first if both values are @NaN@. minNaN :: (RealFloat a) => a -> a -> a minNaN x y | x <= y || isNaN x = x | otherwise = y {-# INLINE minNaN #-} instance IEEE Float where identicalIEEE x y = c_identicalf x y /= 0 {-# INLINE identicalIEEE #-} infinity = 1/0 {-# INLINE infinity #-} nan = (0/0) {-# INLINE nan #-} nanWithPayload n = c_mknanf (fromIntegral n) {-# INLINE nanWithPayload #-} maxNaNPayload _ = 0x003FFFFF {-# INLINE maxNaNPayload #-} nanPayload x = fromIntegral $ c_getnanf x {-# INLINE nanPayload #-} minNormal = 1.17549435e-38 {-# INLINE minNormal #-} maxFinite = 3.40282347e+38 {-# INLINE maxFinite #-} epsilon = 1.19209290e-07 {-# INLINE epsilon #-} copySign = c_copysignf {-# INLINE copySign #-} succIEEE = c_nextupf {-# INLINE succIEEE #-} predIEEE = c_nextdownf {-# INLINE predIEEE #-} bisectIEEE = c_ieeemeanf {-# INLINE bisectIEEE #-} sameSignificandBits = c_feqrelf {-# INLINE sameSignificandBits #-} instance IEEE CFloat where identicalIEEE x y = c_identicalf (realToFrac x) (realToFrac y) /= 0 {-# INLINE identicalIEEE #-} infinity = 1/0 {-# INLINE infinity #-} nan = (0/0) {-# INLINE nan #-} nanWithPayload n = realToFrac $ c_mknanf (fromIntegral n) {-# INLINE nanWithPayload #-} maxNaNPayload _ = 0x003FFFFF {-# INLINE maxNaNPayload #-} nanPayload x = fromIntegral $ c_getnanf (realToFrac x) {-# INLINE nanPayload #-} minNormal = 1.17549435e-38 {-# INLINE minNormal #-} maxFinite = 3.40282347e+38 {-# INLINE maxFinite #-} epsilon = 1.19209290e-07 {-# INLINE epsilon #-} copySign x y = realToFrac $ c_copysignf (realToFrac x) (realToFrac y) {-# INLINE copySign #-} succIEEE x = realToFrac $ c_nextupf (realToFrac x) {-# INLINE succIEEE #-} predIEEE x = realToFrac $ c_nextdownf (realToFrac x) {-# INLINE predIEEE #-} bisectIEEE x y = realToFrac $ c_ieeemeanf (realToFrac x) (realToFrac y) {-# INLINE bisectIEEE #-} sameSignificandBits x y = c_feqrelf (realToFrac x) (realToFrac y) {-# INLINE sameSignificandBits #-} instance IEEE Double where identicalIEEE x y = c_identical x y /= 0 {-# INLINE identicalIEEE #-} infinity = 1/0 {-# INLINE infinity #-} nan = (0/0) {-# INLINE nan #-} nanWithPayload n = c_mknan n {-# INLINE nanWithPayload #-} maxNaNPayload _ = 0x0007FFFFFFFFFFFF {-# INLINE maxNaNPayload #-} nanPayload x = c_getnan x {-# INLINE nanPayload #-} minNormal = 2.2250738585072014e-308 {-# INLINE minNormal #-} maxFinite = 1.7976931348623157e+308 {-# INLINE maxFinite #-} epsilon = 2.2204460492503131e-16 {-# INLINE epsilon #-} copySign = c_copysign {-# INLINE copySign #-} succIEEE = c_nextup {-# INLINE succIEEE #-} predIEEE = c_nextdown {-# INLINE predIEEE #-} bisectIEEE = c_ieeemean {-# INLINE bisectIEEE #-} sameSignificandBits = c_feqrel {-# INLINE sameSignificandBits #-} instance IEEE CDouble where identicalIEEE x y = c_identical (realToFrac x) (realToFrac y) /= 0 {-# INLINE identicalIEEE #-} infinity = 1/0 {-# INLINE infinity #-} nan = (0/0) {-# INLINE nan #-} nanWithPayload n = realToFrac $ c_mknan n {-# INLINE nanWithPayload #-} maxNaNPayload _ = 0x0007FFFFFFFFFFFF {-# INLINE maxNaNPayload #-} nanPayload x = c_getnan (realToFrac x) {-# INLINE nanPayload #-} minNormal = 2.2250738585072014e-308 {-# INLINE minNormal #-} maxFinite = 1.7976931348623157e+308 {-# INLINE maxFinite #-} epsilon = 2.2204460492503131e-16 {-# INLINE epsilon #-} succIEEE x = realToFrac $ c_nextup (realToFrac x) {-# INLINE succIEEE #-} copySign x y = realToFrac $ c_copysign (realToFrac x) (realToFrac y) {-# INLINE copySign #-} predIEEE x = realToFrac $ c_nextdown (realToFrac x) {-# INLINE predIEEE #-} bisectIEEE x y = realToFrac $ c_ieeemean (realToFrac x) (realToFrac y) {-# INLINE bisectIEEE #-} sameSignificandBits x y = c_feqrel (realToFrac x) (realToFrac y) {-# INLINE sameSignificandBits #-} foreign import ccall unsafe "identical" c_identical :: Double -> Double -> Int foreign import ccall unsafe "identicalf" c_identicalf :: Float -> Float -> Int foreign import ccall unsafe "feqrel" c_feqrel :: Double -> Double -> Int foreign import ccall unsafe "feqrelf" c_feqrelf :: Float -> Float -> Int foreign import ccall unsafe "nextup" c_nextup :: Double -> Double foreign import ccall unsafe "nextupf" c_nextupf :: Float -> Float foreign import ccall unsafe "nextdown" c_nextdown :: Double -> Double foreign import ccall unsafe "nextdownf" c_nextdownf :: Float -> Float foreign import ccall unsafe "ieeemean" c_ieeemean :: Double -> Double -> Double foreign import ccall unsafe "ieeemeanf" c_ieeemeanf :: Float -> Float -> Float foreign import ccall unsafe "copysign" c_copysign :: Double -> Double -> Double foreign import ccall unsafe "copysignf" c_copysignf :: Float -> Float -> Float foreign import ccall unsafe "mknan" c_mknan :: Word64 -> Double foreign import ccall unsafe "getnan" c_getnan :: Double -> Word64 foreign import ccall unsafe "mknanf" c_mknanf :: Word32 -> Float foreign import ccall unsafe "getnanf" c_getnanf :: Float -> Word32 ieee754-0.7.8/Data/AEq.hs000644 000765 000024 00000037405 12643600076 015053 0ustar00ptrckstaff000000 000000 {-# LANGUAGE FlexibleInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Data.AEq -- Copyright : Copyright (c) 2010, Patrick Perry -- License : BSD3 -- Maintainer : Patrick Perry -- Stability : experimental -- -- A type class for approximate and exact equalilty comparisons and instances -- for common data types. module Data.AEq ( AEq(..), ) where import Foreign import Foreign.C.Types import Data.Complex import Numeric.IEEE infix 4 ===, ~== -- | Types with approximate and exact equality comparisons. class Eq a => AEq a where -- | An exact equality comparison. -- -- For real 'IEEE' types, two values are equivalent in the -- following cases: -- -- * both values are @+0@; -- -- * both values are @-0@; -- -- * both values are nonzero and equal to each other -- (according to '=='); -- -- * both values are @NaN@ with the same payload and sign. -- -- For complex 'IEEE' types, two values are equivalent if their -- real and imaginary parts are equivalent. -- (===) :: a -> a -> Bool (===) = (==) {-# INLINE (===) #-} -- | An approximate equality comparison operator. -- -- For real 'IEEE' types, two values are approximately equal in the -- following cases: -- -- * at least half of their significand bits agree; -- -- * both values are less than 'epsilon'; -- -- * both values are @NaN@. -- -- For complex 'IEEE' types, two values are approximately equal in the -- followiing cases: -- -- * their magnitudes are approximately equal and the angle between -- them is less than @32*'epsilon'@; -- -- * both magnitudes are less than 'epsilon'; -- -- * both have a @NaN@ real or imaginary part. -- -- Admitedly, the @32@ is a bit of a hack. Future versions of the -- library may switch to a more principled test of the angle. -- (~==) :: a -> a -> Bool (~==) = (==) {-# INLINE (~==) #-} approxEqIEEE :: (IEEE a) => a -> a -> Bool approxEqIEEE x y = ( sameSignificandBits x y >= d || (abs x < epsilon && abs y < epsilon) || (isNaN x && isNaN y) ) where d = (floatDigits x + 1) `div` 2 {-# INLINE approxEqIEEE #-} identicalComplexIEEE :: (IEEE a) => Complex a -> Complex a -> Bool identicalComplexIEEE (x1 :+ y1) (x2 :+ y2) = (identicalIEEE x1 x2) && (identicalIEEE y1 y2) {-# INLINE identicalComplexIEEE #-} approxEqComplexIEEE :: (IEEE a) => Complex a -> Complex a -> Bool approxEqComplexIEEE z1 z2 = let (r1,c1) = polar z1 (r2,c2) = polar z2 angle = abs (c1 - c2) in ( ( approxEqIEEE r1 r2 && (angle < 32*epsilon || angle > 2*(pi - 16*epsilon) || isNaN angle) ) || (r1 < epsilon && r2 < epsilon) ) {-# INLINE approxEqComplexIEEE #-} instance AEq Float where (===) = identicalIEEE {-# INLINE (===) #-} (~==) = approxEqIEEE {-# INLINE (~==) #-} instance AEq Double where (===) = identicalIEEE {-# INLINE (===) #-} (~==) = approxEqIEEE {-# INLINE (~==) #-} instance AEq (Complex Float) where (===) = identicalComplexIEEE {-# INLINE (===) #-} (~==) = approxEqComplexIEEE {-# INLINE (~==) #-} instance AEq (Complex Double) where (===) = identicalComplexIEEE {-# INLINE (===) #-} (~==) = approxEqComplexIEEE {-# INLINE (~==) #-} instance AEq CFloat where (===) = identicalIEEE {-# INLINE (===) #-} (~==) = approxEqIEEE {-# INLINE (~==) #-} instance AEq CDouble where (===) = identicalIEEE {-# INLINE (===) #-} (~==) = approxEqIEEE {-# INLINE (~==) #-} instance AEq (Complex CFloat) where (===) = identicalComplexIEEE {-# INLINE (===) #-} (~==) = approxEqComplexIEEE {-# INLINE (~==) #-} instance AEq (Complex CDouble) where (===) = identicalComplexIEEE {-# INLINE (===) #-} (~==) = approxEqComplexIEEE {-# INLINE (~==) #-} instance AEq Bool instance AEq Char instance AEq Int instance AEq Int8 instance AEq Int16 instance AEq Int32 instance AEq Int64 instance AEq Integer instance AEq Ordering instance AEq Word instance AEq Word8 instance AEq Word16 instance AEq Word32 instance AEq Word64 instance AEq () instance AEq WordPtr instance AEq IntPtr instance AEq (StablePtr a) instance AEq (Ptr a) instance AEq (FunPtr a) instance AEq (ForeignPtr a) instance AEq CChar instance AEq CSChar instance AEq CUChar instance AEq CShort instance AEq CUShort instance AEq CInt instance AEq CUInt instance AEq CLong instance AEq CULong instance AEq CPtrdiff instance AEq CSize instance AEq CWchar instance AEq CSigAtomic instance AEq CLLong instance AEq CULLong instance AEq CIntPtr instance AEq CUIntPtr instance AEq CIntMax instance AEq CUIntMax instance AEq CClock instance AEq CTime eqListsWith :: (a -> a -> Bool) -> [a] -> [a] -> Bool eqListsWith f (x:xs) (y:ys) = f x y && eqListsWith f xs ys eqListsWith _ [] [] = True eqListsWith _ _ _ = False {-# INLINE eqListsWith #-} instance (AEq a) => AEq [a] where (===) = eqListsWith (===) {-# INLINE (===) #-} (~==) = eqListsWith (~==) {-# INLINE (~==) #-} instance (AEq a) => AEq (Maybe a) where (===) Nothing Nothing = True (===) (Just x) (Just y) = (===) x y (===) _ _ = False {-# INLINE (===) #-} (~==) Nothing Nothing = True (~==) (Just x) (Just y) = (~==) x y (~==) _ _ = False {-# INLINE (~==) #-} instance (AEq a, AEq b) => AEq (Either a b) where (===) (Left a1) (Left a2) = (===) a1 a2 (===) (Right b1) (Right b2) = (===) b1 b2 (===) _ _ = False {-# INLINE (===) #-} (~==) (Left a1) (Left a2) = (~==) a1 a2 (~==) (Right b1) (Right b2) = (~==) b1 b2 (~==) _ _ = False {-# INLINE (~==) #-} instance (AEq a, AEq b) => AEq (a,b) where (===) (a1,b1) (a2,b2) = ( ((===) a1 a2) && ((===) b1 b2) ) {-# INLINE (===) #-} (~==) (a1,b1) (a2,b2) = ( ((~==) a1 a2) && ((~==) b1 b2) ) {-# INLINE (~==) #-} instance (AEq a, AEq b, AEq c) => AEq (a,b,c) where (===) (a1,b1,c1) (a2,b2,c2) = ( ((===) a1 a2) && ((===) b1 b2) && ((===) c1 c2) ) {-# INLINE (===) #-} (~==) (a1,b1,c1) (a2,b2,c2) = ( ((~==) a1 a2) && ((~==) b1 b2) && ((~==) c1 c2) ) {-# INLINE (~==) #-} instance (AEq a, AEq b, AEq c, AEq d) => AEq (a,b,c,d) where (===) (a1,b1,c1,d1) (a2,b2,c2,d2) = ( ((===) a1 a2) && ((===) b1 b2) && ((===) c1 c2) && ((===) d1 d2) ) {-# INLINE (===) #-} (~==) (a1,b1,c1,d1) (a2,b2,c2,d2) = ( ((~==) a1 a2) && ((~==) b1 b2) && ((~==) c1 c2) && ((~==) d1 d2) ) {-# INLINE (~==) #-} instance (AEq a, AEq b, AEq c, AEq d, AEq e) => AEq (a,b,c,d,e) where (===) (a1,b1,c1,d1,e1) (a2,b2,c2,d2,e2) = ( ((===) a1 a2) && ((===) b1 b2) && ((===) c1 c2) && ((===) d1 d2) && ((===) e1 e2) ) {-# INLINE (===) #-} (~==) (a1,b1,c1,d1,e1) (a2,b2,c2,d2,e2) = ( ((~==) a1 a2) && ((~==) b1 b2) && ((~==) c1 c2) && ((~==) d1 d2) && ((~==) e1 e2) ) {-# INLINE (~==) #-} instance (AEq a, AEq b, AEq c, AEq d, AEq e, AEq f) => AEq (a,b,c,d,e,f) where (===) (a1,b1,c1,d1,e1,f1) (a2,b2,c2,d2,e2,f2) = ( ((===) a1 a2) && ((===) b1 b2) && ((===) c1 c2) && ((===) d1 d2) && ((===) e1 e2) && ((===) f1 f2) ) {-# INLINE (===) #-} (~==) (a1,b1,c1,d1,e1,f1) (a2,b2,c2,d2,e2,f2) = ( ((~==) a1 a2) && ((~==) b1 b2) && ((~==) c1 c2) && ((~==) d1 d2) && ((~==) e1 e2) && ((~==) f1 f2) ) {-# INLINE (~==) #-} instance (AEq a, AEq b, AEq c, AEq d, AEq e, AEq f, AEq g) => AEq (a,b,c,d,e,f,g) where (===) (a1,b1,c1,d1,e1,f1,g1) (a2,b2,c2,d2,e2,f2,g2) = ( ((===) a1 a2) && ((===) b1 b2) && ((===) c1 c2) && ((===) d1 d2) && ((===) e1 e2) && ((===) f1 f2) && ((===) g1 g2) ) {-# INLINE (===) #-} (~==) (a1,b1,c1,d1,e1,f1,g1) (a2,b2,c2,d2,e2,f2,g2) = ( ((~==) a1 a2) && ((~==) b1 b2) && ((~==) c1 c2) && ((~==) d1 d2) && ((~==) e1 e2) && ((~==) f1 f2) && ((~==) g1 g2) ) {-# INLINE (~==) #-} instance (AEq a, AEq b, AEq c, AEq d, AEq e, AEq f, AEq g, AEq h) => AEq (a,b,c,d,e,f,g,h) where (===) (a1,b1,c1,d1,e1,f1,g1,h1) (a2,b2,c2,d2,e2,f2,g2,h2) = ( ((===) a1 a2) && ((===) b1 b2) && ((===) c1 c2) && ((===) d1 d2) && ((===) e1 e2) && ((===) f1 f2) && ((===) g1 g2) && ((===) h1 h2) ) {-# INLINE (===) #-} (~==) (a1,b1,c1,d1,e1,f1,g1,h1) (a2,b2,c2,d2,e2,f2,g2,h2) = ( ((~==) a1 a2) && ((~==) b1 b2) && ((~==) c1 c2) && ((~==) d1 d2) && ((~==) e1 e2) && ((~==) f1 f2) && ((~==) g1 g2) && ((~==) h1 h2) ) {-# INLINE (~==) #-} instance (AEq a, AEq b, AEq c, AEq d, AEq e, AEq f, AEq g, AEq h, AEq i) => AEq (a,b,c,d,e,f,g,h,i) where (===) (a1,b1,c1,d1,e1,f1,g1,h1,i1) (a2,b2,c2,d2,e2,f2,g2,h2,i2) = ( ((===) a1 a2) && ((===) b1 b2) && ((===) c1 c2) && ((===) d1 d2) && ((===) e1 e2) && ((===) f1 f2) && ((===) g1 g2) && ((===) h1 h2) && ((===) i1 i2) ) {-# INLINE (===) #-} (~==) (a1,b1,c1,d1,e1,f1,g1,h1,i1) (a2,b2,c2,d2,e2,f2,g2,h2,i2) = ( ((~==) a1 a2) && ((~==) b1 b2) && ((~==) c1 c2) && ((~==) d1 d2) && ((~==) e1 e2) && ((~==) f1 f2) && ((~==) g1 g2) && ((~==) h1 h2) && ((~==) i1 i2) ) {-# INLINE (~==) #-} instance (AEq a, AEq b, AEq c, AEq d, AEq e, AEq f, AEq g, AEq h, AEq i, AEq j) => AEq (a,b,c,d,e,f,g,h,i,j) where (===) (a1,b1,c1,d1,e1,f1,g1,h1,i1,j1) (a2,b2,c2,d2,e2,f2,g2,h2,i2,j2) = ( ((===) a1 a2) && ((===) b1 b2) && ((===) c1 c2) && ((===) d1 d2) && ((===) e1 e2) && ((===) f1 f2) && ((===) g1 g2) && ((===) h1 h2) && ((===) i1 i2) && ((===) j1 j2) ) {-# INLINE (===) #-} (~==) (a1,b1,c1,d1,e1,f1,g1,h1,i1,j1) (a2,b2,c2,d2,e2,f2,g2,h2,i2,j2) = ( ((~==) a1 a2) && ((~==) b1 b2) && ((~==) c1 c2) && ((~==) d1 d2) && ((~==) e1 e2) && ((~==) f1 f2) && ((~==) g1 g2) && ((~==) h1 h2) && ((~==) i1 i2) && ((~==) j1 j2) ) {-# INLINE (~==) #-} instance (AEq a, AEq b, AEq c, AEq d, AEq e, AEq f, AEq g, AEq h, AEq i, AEq j, AEq k) => AEq (a,b,c,d,e,f,g,h,i,j,k) where (===) (a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1) (a2,b2,c2,d2,e2,f2,g2,h2,i2,j2,k2) = ( ((===) a1 a2) && ((===) b1 b2) && ((===) c1 c2) && ((===) d1 d2) && ((===) e1 e2) && ((===) f1 f2) && ((===) g1 g2) && ((===) h1 h2) && ((===) i1 i2) && ((===) j1 j2) && ((===) k1 k2) ) {-# INLINE (===) #-} (~==) (a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1) (a2,b2,c2,d2,e2,f2,g2,h2,i2,j2,k2) = ( ((~==) a1 a2) && ((~==) b1 b2) && ((~==) c1 c2) && ((~==) d1 d2) && ((~==) e1 e2) && ((~==) f1 f2) && ((~==) g1 g2) && ((~==) h1 h2) && ((~==) i1 i2) && ((~==) j1 j2) && ((~==) k1 k2) ) {-# INLINE (~==) #-} instance (AEq a, AEq b, AEq c, AEq d, AEq e, AEq f, AEq g, AEq h, AEq i, AEq j, AEq k, AEq l) => AEq (a,b,c,d,e,f,g,h,i,j,k,l) where (===) (a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1) (a2,b2,c2,d2,e2,f2,g2,h2,i2,j2,k2,l2) = ( ((===) a1 a2) && ((===) b1 b2) && ((===) c1 c2) && ((===) d1 d2) && ((===) e1 e2) && ((===) f1 f2) && ((===) g1 g2) && ((===) h1 h2) && ((===) i1 i2) && ((===) j1 j2) && ((===) k1 k2) && ((===) l1 l2) ) {-# INLINE (===) #-} (~==) (a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1) (a2,b2,c2,d2,e2,f2,g2,h2,i2,j2,k2,l2) = ( ((~==) a1 a2) && ((~==) b1 b2) && ((~==) c1 c2) && ((~==) d1 d2) && ((~==) e1 e2) && ((~==) f1 f2) && ((~==) g1 g2) && ((~==) h1 h2) && ((~==) i1 i2) && ((~==) j1 j2) && ((~==) k1 k2) && ((~==) l1 l2) ) {-# INLINE (~==) #-} instance (AEq a, AEq b, AEq c, AEq d, AEq e, AEq f, AEq g, AEq h, AEq i, AEq j, AEq k, AEq l, AEq m) => AEq (a,b,c,d,e,f,g,h,i,j,k,l,m) where (===) (a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1) (a2,b2,c2,d2,e2,f2,g2,h2,i2,j2,k2,l2,m2) = ( ((===) a1 a2) && ((===) b1 b2) && ((===) c1 c2) && ((===) d1 d2) && ((===) e1 e2) && ((===) f1 f2) && ((===) g1 g2) && ((===) h1 h2) && ((===) i1 i2) && ((===) j1 j2) && ((===) k1 k2) && ((===) l1 l2) && ((===) m1 m2) ) {-# INLINE (===) #-} (~==) (a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1) (a2,b2,c2,d2,e2,f2,g2,h2,i2,j2,k2,l2,m2) = ( ((~==) a1 a2) && ((~==) b1 b2) && ((~==) c1 c2) && ((~==) d1 d2) && ((~==) e1 e2) && ((~==) f1 f2) && ((~==) g1 g2) && ((~==) h1 h2) && ((~==) i1 i2) && ((~==) j1 j2) && ((~==) k1 k2) && ((~==) l1 l2) && ((~==) m1 m2) ) {-# INLINE (~==) #-} instance (AEq a, AEq b, AEq c, AEq d, AEq e, AEq f, AEq g, AEq h, AEq i, AEq j, AEq k, AEq l, AEq m, AEq n) => AEq (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where (===) (a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1) (a2,b2,c2,d2,e2,f2,g2,h2,i2,j2,k2,l2,m2,n2) = ( ((===) a1 a2) && ((===) b1 b2) && ((===) c1 c2) && ((===) d1 d2) && ((===) e1 e2) && ((===) f1 f2) && ((===) g1 g2) && ((===) h1 h2) && ((===) i1 i2) && ((===) j1 j2) && ((===) k1 k2) && ((===) l1 l2) && ((===) m1 m2) && ((===) n1 n2) ) {-# INLINE (===) #-} (~==) (a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1) (a2,b2,c2,d2,e2,f2,g2,h2,i2,j2,k2,l2,m2,n2) = ( ((~==) a1 a2) && ((~==) b1 b2) && ((~==) c1 c2) && ((~==) d1 d2) && ((~==) e1 e2) && ((~==) f1 f2) && ((~==) g1 g2) && ((~==) h1 h2) && ((~==) i1 i2) && ((~==) j1 j2) && ((~==) k1 k2) && ((~==) l1 l2) && ((~==) m1 m2) && ((~==) n1 n2) ) {-# INLINE (~==) #-} instance (AEq a, AEq b, AEq c, AEq d, AEq e, AEq f, AEq g, AEq h, AEq i, AEq j, AEq k, AEq l, AEq m, AEq n, AEq o) => AEq (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where (===) (a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1) (a2,b2,c2,d2,e2,f2,g2,h2,i2,j2,k2,l2,m2,n2,o2) = ( ((===) a1 a2) && ((===) b1 b2) && ((===) c1 c2) && ((===) d1 d2) && ((===) e1 e2) && ((===) f1 f2) && ((===) g1 g2) && ((===) h1 h2) && ((===) i1 i2) && ((===) j1 j2) && ((===) k1 k2) && ((===) l1 l2) && ((===) m1 m2) && ((===) n1 n2) && ((===) o1 o2) ) {-# INLINE (===) #-} (~==) (a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1) (a2,b2,c2,d2,e2,f2,g2,h2,i2,j2,k2,l2,m2,n2,o2) = ( ((~==) a1 a2) && ((~==) b1 b2) && ((~==) c1 c2) && ((~==) d1 d2) && ((~==) e1 e2) && ((~==) f1 f2) && ((~==) g1 g2) && ((~==) h1 h2) && ((~==) i1 i2) && ((~==) j1 j2) && ((~==) k1 k2) && ((~==) l1 l2) && ((~==) m1 m2) && ((~==) n1 n2) && ((~==) o1 o2) ) {-# INLINE (~==) #-} ieee754-0.7.8/cbits/double.c000644 000765 000024 00000004553 12643600076 015720 0ustar00ptrckstaff000000 000000 #include #include #include #define REAL double #define REAL_ABS fabs #define REAL_MIN_NORMAL DBL_MIN #define REAL_EPSILON DBL_EPSILON #define REAL_MAX DBL_MAX #define REAL_MANT_DIG DBL_MANT_DIG #define FEQREL feqrel #include "feqrel_source.c" union double_t { double d; uint64_t w; }; int identical (double x, double y) { union double_t ux = { x }; union double_t uy = { y }; return ux.w == uy.w; } double copysign (double x, double y) { union double_t ux = { x }; union double_t uy = { y }; union double_t uz; uint64_t val = ux.w & 0x7FFFFFFFFFFFFFFFULL; uint64_t sign = uy.w & 0x8000000000000000ULL; uz.w = sign | val; return uz.d; } /* ported from tango/math/IEEE.d */ double nextup (double x) { union double_t ps = { x }; if ((ps.w & 0x7FF0000000000000ULL) == 0x7FF0000000000000ULL) { /* First, deal with NANs and infinity */ if (x == -INFINITY) return -REAL_MAX; return x; // +INF and NAN are unchanged. } if (ps.w & 0x8000000000000000ULL) { /* Negative number */ if (ps.w == 0x8000000000000000ULL) { /* it was negative zero */ ps.w = 0x0000000000000001ULL; /* change to smallest subnormal */ return ps.d; } --ps.w; } else { /* Positive number */ ++ps.w; } return ps.d; } /* ported from tango/math/IEEE.d */ double nextdown (double x) { return -nextup(-x); } /* ported from tango/math/IEEE.d */ double ieeemean (double x, double y) { if (!((x>=0 && y>=0) || (x<=0 && y<=0))) return NAN; union double_t ul; union double_t xl = { x }; union double_t yl = { y }; uint64_t m = ( (xl.w & 0x7FFFFFFFFFFFFFFFULL) + (yl.w & 0x7FFFFFFFFFFFFFFFULL) ) >> 1; m |= (xl.w & 0x8000000000000000ULL); ul.w = m; return ul.d; } double mknan (uint64_t payload) { union double_t x = { NAN }; /* get sign, exponent, and quiet bit from NAN */ x.w &= 0xFFF8000000000000ULL; /* ignore sign, exponent, and quiet bit in payload */ payload &= 0x0007FFFFFFFFFFFFULL; x.w |= payload; return x.d; } uint64_t getnan (double x) { union double_t payload = { x }; /* clear sign, exponent, and quiet bit */ payload.w &= 0x0007FFFFFFFFFFFFULL; return payload.w; } ieee754-0.7.8/cbits/feqrel_source.c000644 000765 000024 00000013430 12643600076 017276 0ustar00ptrckstaff000000 000000 /* adapted from Tango version 0.99.9, BSD Licensed */ /* Define WORDS_BIGENDIAN on big-endian platforms; otherwise, assume * little-endian. * * Endianness detection modified from http://esr.ibiblio.org/?p=5095 and * https://gist.github.com/panzi/6856583 . * * In the subsequent code we rely on endianness being the same for integers * and floats; this is true for modern systems but false in a few historical * machines and some old ARM processors; see * http://en.wikipedia.org/wiki/Endianness#Floating-point_and_endianness . */ #if defined(__BYTE_ORDER__) /* (1) Try to use the GCC/Clang __BYTE_ORDER__ defines */ # if __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ # define WORDS_BIGENDIAN 1 # elif __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__ # undef WORDS_BIGENDIAN # else # error byte order not supported # endif /* (2) Otherwise, try the __BIG_ENDIAN__ and __LITTLE_ENDIAN__ defines */ #elif defined(__BIG_ENDIAN__) # define WORDS_BIGENDIAN 1 #elif defined(__LITTLE_ENDIAN__) # undef WORDS_BIGENDIAN #else /* (3) As a last resort, try platform-specific fallbacks: */ # if defined(_WIN16) || defined(_WIN32) || defined(_WIN64) /* (a) Assume Windows is little endian (http://stackoverflow.com/a/6449581 ) */ # undef WORDS_BIGENDIAN # else /* (b) Otherwise, use endian.h */ # if (defined(__DragonFly__) || defined(__FreeBSD__) || defined(__NetBSD__) \ || defined(__OpenBSD__)) # include # else # include # endif # if __BYTE_ORDER == __BIG_ENDIAN # define WORDS_BIGENDIAN 1 # elif __BYTE_ORDER == __LITTLE_ENDIAN # undef WORDS_BIGENDIAN # else # error platform not supported: unable to determine endianess # endif # endif #endif /* REAL_EXPMASK is a ushort mask to select the exponent portion (without sign) * REAL_SIGNMASK is a ushort mask to select the sign bit. * REAL_EXPPOS_SHORT is the index of the exponent when represented as a uint16_t array. * REAL_SIGNPOS_BYTE is the index of the sign when represented as a uint8_t array. * REAL_RECIP_EPSILON is the value such that * (smallest_denormal) * REAL_RECIP_EPSILON == REAL_MIN_NORMAL */ #define REAL_RECIP_EPSILON (1 / REAL_EPSILON) #if REAL_MANT_DIG == 24 # define REAL_EXPMASK ((uint16_t) 0x7F80) # define REAL_SIGNMASK ((uint16_t) 0x8000) # define REAL_EXPBIAS ((uint16_t) 0x3F00) # define REAL_EXPBIAS_INT32 ((uint32_t) 0x7F800000) # define REAL_MANTISSAMASK_INT32 ((uint32_t) 0x007FFFFF) # if WORDS_BIGENDIAN # define REAL_EXPPOS_INT16 0 # else # define REAL_EXPPOS_INT16 1 # endif # #elif REAL_MANT_DIG == 53 /* double */ # define REAL_EXPMASK ((uint16_t) 0x7FF0) # define REAL_SIGNMASK ((uint16_t) 0x8000) # define REAL_EXPBIAS ((uint16_t) 0x3FE0) # define REAL_EXPBIAS_INT32 ((uint32_t) 0x7FF00000) # define REAL_MANTISSAMASK_INT32 ((uint32_t) 0x000FFFFF); /* for the MSB only */ # if WORDS_BIGENDIAN # define REAL_EXPPOS_INT16 0 # define REAL_SIGNPOS_BYTE 0 # else # define REAL_EXPPOS_INT16 3 # define REAL_SIGNPOS_BYTE 7 # endif #endif int FEQREL (REAL x, REAL y) { /* Public Domain. Original Author: Don Clugston, 18 Aug 2005. * Ported to C by Patrick Perry, 26 Feb 2010. */ if (x == y) return REAL_MANT_DIG; /* ensure diff!= 0, cope with INF. */ REAL diff = REAL_ABS(x - y); union { REAL r; uint16_t w[sizeof(REAL)/2]; } pa = { x }; union { REAL r; uint16_t w[sizeof(REAL)/2]; } pb = { y }; union { REAL r; uint16_t w[sizeof(REAL)/2]; } pd = { diff }; /* The difference in abs(exponent) between x or y and abs(x-y) * is equal to the number of significand bits of x which are * equal to y. If negative, x and y have different exponents. * If positive, x and y are equal to 'bitsdiff' bits. * AND with 0x7FFF to form the absolute value. * To avoid out-by-1 errors, we subtract 1 so it rounds down * if the exponents were different. This means 'bitsdiff' is * always 1 lower than we want, except that if bitsdiff==0, * they could have 0 or 1 bits in common. */ #if REAL_MANT_DIG == 53 /* double */ int bitsdiff = (( ((pa.w[REAL_EXPPOS_INT16] & REAL_EXPMASK) + (pb.w[REAL_EXPPOS_INT16] & REAL_EXPMASK) - ((uint16_t) 0x8000 - REAL_EXPMASK)) >> 1) - (pd.w[REAL_EXPPOS_INT16] & REAL_EXPMASK)) >> 4; #elif REAL_MANT_DIG == 24 /* float */ int bitsdiff = (( ((pa.w[REAL_EXPPOS_INT16] & REAL_EXPMASK) + (pb.w[REAL_EXPPOS_INT16] & REAL_EXPMASK) - ((uint16_t) 0x8000 - REAL_EXPMASK)) >> 1) - (pd.w[REAL_EXPPOS_INT16] & REAL_EXPMASK)) >> 7; #else # error unsuported floating-point mantissa size #endif if ((pd.w[REAL_EXPPOS_INT16] & REAL_EXPMASK) == 0) { /* Difference is denormal * For denormals, we need to add the number of zeros that * lie at the start of diff's significand. * We do this by multiplying by 2^REAL_MANT_DIG */ pd.r *= REAL_RECIP_EPSILON; #if REAL_MANT_DIG == 53 /* double */ return (bitsdiff + REAL_MANT_DIG - (pd.w[REAL_EXPPOS_INT16] >> 4)); #elif REAL_MANT_DIG == 24 /* float */ return (bitsdiff + REAL_MANT_DIG - (pd.w[REAL_EXPPOS_INT16] >> 7)); #else # error unsuported floating-point mantissa size #endif } if (bitsdiff > 0) return bitsdiff + 1; /* add the 1 we subtracted before */ /* Avoid out-by-1 errors when factor is almost 2. */ return (bitsdiff == 0 && !((pa.w[REAL_EXPPOS_INT16] ^ pb.w[REAL_EXPPOS_INT16]) & REAL_EXPMASK)) ? 1 : 0; } #undef REAL_RECIP_EPSILON #undef REAL_EXPMASK #undef REAL_SIGNMASK #undef REAL_EXPBIAS #undef REAL_EXPBIAS_INT32 #undef REAL_MANTISSAMASK_INT32 #undef REAL_EXPPOS_INT16 #undef REAL_SIGNPOS_BYTE ieee754-0.7.8/cbits/float.c000644 000765 000024 00000004273 12643600076 015552 0ustar00ptrckstaff000000 000000 #include #include #include #define REAL float #define REAL_ABS fabsf #define REAL_MIN_NORMAL FLT_MIN #define REAL_EPSILON FLT_EPSILON #define REAL_MAX FLT_MAX #define REAL_MANT_DIG FLT_MANT_DIG #define FEQREL feqrelf #include "feqrel_source.c" union float_t { float f; uint32_t w; }; int identicalf (float x, float y) { union float_t ux = { x }; union float_t uy = { y }; return ux.w == uy.w; } float copysignf (float x, float y) { union float_t ux = { x }; union float_t uy = { y }; union float_t uz; uint32_t val = ux.w & 0x7FFFFFFF; uint32_t sign = uy.w & 0x80000000; uz.w = sign | val; return uz.f; } /* ported from tango/math/IEEE.d */ float nextupf (float x) { union float_t ps = { x }; if ((ps.w & 0x7F800000) == 0x7F800000) { /* First, deal with NANs and infinity */ if (x == -INFINITY) return -REAL_MAX; return x; /* +INF and NAN are unchanged. */ } if (ps.w & 0x80000000) { /* Negative number */ if (ps.w == 0x80000000) { /* it was negative zero */ ps.w = 0x00000001; /* change to smallest subnormal */ return ps.f; } --ps.w; } else { /* Positive number */ ++ps.w; } return ps.f; } /* ported from tango/math/IEEE.d */ float nextdownf (float x) { return -nextupf(-x); } /* ported from tango/math/IEEE.d */ float ieeemeanf (float x, float y) { if (!((x>=0 && y>=0) || (x<=0 && y<=0))) return NAN; union float_t ul; union float_t xl = { x }; union float_t yl = { y }; uint32_t m = ((xl.w & 0x7FFFFFFF) + (yl.w & 0x7FFFFFFF)) >> 1; m |= (xl.w & 0x80000000); ul.w = m; return ul.f; } float mknanf (uint32_t payload) { union float_t ux = { NAN }; /* get sign, exponent, and quiet bit from NAN */ ux.w &= 0xFFC00000; /* ignore sign, exponent, and quiet bit in payload */ payload &= 0x003FFFFF; ux.w |= payload; return ux.f; } uint32_t getnanf (float x) { union float_t payload = { x }; /* clear sign, exponent, and quiet bit */ payload.w &= 0x003FFFFF; return payload.w; }