Mantissa (empty) → 0.1.0.0

raw patch · 9 files changed

+399/−0 lines, 9 filesdep +Mantissadep +basedep +hspecsetup-changed

Dependencies added: Mantissa, base, hspec

Files

• CHANGELOG.md +18/−0
• LICENSE +26/−0
• Mantissa.cabal +58/−0
• README.md +21/−0
• Setup.hs +2/−0
• src/Numeric/Mantissa.hs +104/−0
• src/Numeric/Mantissa/Unboxed.hs +84/−0
• test/Numeric/MantissaSpec.hs +84/−0
• test/Spec.hs +2/−0

@@ -0,0 +1,18 @@+# Changelog for `Mantissa`++All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),+and this project adheres to the+[Haskell Package Versioning Policy](https://pvp.haskell.org/).++## Unreleased++## 0.1.0.0 - 2024-09-04++Initial release.++- Boxed and unboxed versions+- Basic arithmetic+- Basic conversions+- Num, Fractional, Eq and Ord instances

@@ -0,0 +1,26 @@+Copyright 2024 James Cranch++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 copyright holder 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 HOLDER 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.

@@ -0,0 +1,58 @@+cabal-version: 2.2++-- This file has been generated from package.yaml by hpack version 0.36.0.+--+-- see: https://github.com/sol/hpack++name:           Mantissa+version:        0.1.0.0+synopsis:       Reals in the interval [0,1), as machine words+description:    Please see the README on GitHub at <https://github.com/jcranch/Mantissa#readme>+category:       Numeric+homepage:       https://github.com/jcranch/mantissa#readme+bug-reports:    https://github.com/jcranch/mantissa/issues+author:         James Cranch+maintainer:     cranch@cantab.net+copyright:      2024 James Cranch+license:        BSD-3-Clause+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/jcranch/mantissa++library+  exposed-modules:+      Numeric.Mantissa+      Numeric.Mantissa.Unboxed+  other-modules:+      Paths_Mantissa+  autogen-modules:+      Paths_Mantissa+  hs-source-dirs:+      src+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints+  build-depends:+      base >=4.7 && <5+  default-language: Haskell2010++test-suite Mantissa-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Numeric.MantissaSpec+      Paths_Mantissa+  autogen-modules:+      Paths_Mantissa+  hs-source-dirs:+      test+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -Wwarn=missing-home-modules -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      Mantissa+    , base >=4.7 && <5+    , hspec >=2.7 && <2.12+  default-language: Haskell2010

@@ -0,0 +1,21 @@+# Mantissa++Reals in the interval [0,1), implemented as machine words. Boxed and+unboxed variants are available.++Arithmetic is available; addition and subtraction is taken+modulo 1. On the whole, the user is responsible for ensuring that,+when these numbers are produced by division (in any of several+possible ways), the result will be in the interval [0,1).++## Nomenclature++As of 2024, most people would call this concept a+[fractional part](https://en.wikipedia.org/wiki/Fractional_part),+but the name+[Fractional](https://hackage.haskell.org/package/base-4.20.0.1/docs/Prelude.html#t:Fractional)+is already in use in Haskell base for something different. Thus we use the slightly obscure name+[mantissa](https://en.wikipedia.org/wiki/Common_logarithm#Mantissa_and_characteristic).+++

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,104 @@+{-#+    LANGUAGE+      BangPatterns,+      MagicHash,+      UnboxedTuples,+      UnliftedNewtypes+  #-}++-- | Real numbers in [0,1), represented as fixed-point reals stored in+-- a machine word.+--+-- `Fractional` would arguably be a better name, but is of course+-- already in use.+module Numeric.Mantissa (+  Mantissa(..),+  oneMinusE,+  mantissaFromWord,+  mantissaToWord,+  mantissaToFractional,+  ) where++import Data.Ratio ((%), numerator, denominator)+import GHC.Num (integerToWord, integerFromWord)+import GHC.Exts (Word(..), isTrue#, not#)+import Numeric.Mantissa.Unboxed+++-- | A real number in [0,1), represented as a boxed word+data Mantissa = M# Mantissa#++-- | The largest possible mantissa, just a tiny bit less than one+oneMinusE :: Mantissa+oneMinusE = M# (Mantissa# (not# 0##))++instance Num Mantissa where++  -- | Addition is modulo 1+  M# a + M# b = M# (plusMod1Mantissa# a b)+  +  -- | Subtraction is modulo 1+  M# a - M# b = M# (minusMod1Mantissa# a b)++  M# a * M# b = M# (timesMantissa# a b)++  -- | All mantissas are positive, so `abs` is the identity function+  abs = id++  -- | The only integer representable as a mantissa is 0+  fromInteger 0 = M# (Mantissa# 0##)+  fromInteger _ = error "fromInteger: can only convert 0 to mantissa"++  -- | Note that `signum` does not return 1 for positive numbers,+  -- since 1 is not available+  signum 0 = 0+  signum _ = oneMinusE++instance Eq Mantissa where+  M# a == M# b = isTrue# (eqMantissa# a b)++instance Ord Mantissa where+  M# a < M# b = isTrue# (ltMantissa# a b)+  M# a > M# b = isTrue# (gtMantissa# a b)+  M# a <= M# b = isTrue# (leMantissa# a b)+  M# a >= M# b = isTrue# (geMantissa# a b)++mantissaFromWord :: Word -> Mantissa+mantissaFromWord (W# w) = M# (Mantissa# w)++mantissaToWord :: Mantissa -> Word+mantissaToWord (M# (Mantissa# w)) = W# w++-- | The unsigned integer stored in a mantissa ("what multiple of the+-- smallest possible mantissa is this?"). This is used as a step in+-- some more mathematically meaningful functionality.+mantissaSerial :: Mantissa -> Integer+mantissaSerial = integerFromWord . mantissaToWord++-- | One more than the largest integer in a word (2^64 on a 64-bit+-- machine, for example).+--+-- I'd be interested to know if there's a more idiomatic way of doing+-- this.+wordMultiple :: Integer+wordMultiple = 1 + mantissaSerial oneMinusE++instance Fractional Mantissa where++  -- | The user is responsible for ensuring that, when they take a/b,+  -- then a is less than b.+  M# a / M# b = M# (quotMantissa# a b)++  recip _ = error "recip: cannot take reciprocal of a mantissa"++  -- | The user is responsible for ensuring that, when they use+  -- fromRational on a fraction, the numerator is less than the+  -- denominator (and both are positive).+  fromRational u = let+    q = quot (wordMultiple * numerator u) (denominator u)+    in mantissaFromWord (integerToWord q)++-- | Convert a mantissa to any Fractional type, implemented using+-- `fromRational`+mantissaToFractional :: Fractional a => Mantissa -> a+mantissaToFractional m = fromRational (mantissaSerial m % wordMultiple)

@@ -0,0 +1,84 @@+{-#+    LANGUAGE+      BangPatterns,+      MagicHash,+      UnboxedTuples,+      UnliftedNewtypes+  #-}++-- | Real numbers in [0,1), represented as fixed-point reals stored in+-- a machine word.+--+-- `Fractional` would arguably be a better name, but is of course+-- already in use.+module Numeric.Mantissa.Unboxed (+  Mantissa#(..),+  eqMantissa#,+  neMantissa#,+  gtMantissa#,+  ltMantissa#,+  geMantissa#,+  leMantissa#,+  plusMod1Mantissa#,+  minusMod1Mantissa#,+  plusWithOverflowMantissa#,+  minusWithOverflowMantissa#,+  timesMantissa#,+  quotMantissa#,+  ) where++import GHC.Exts+++-- | A real number in [0,1), represented as an unboxed word+newtype Mantissa# = Mantissa# Word#++eqMantissa# :: Mantissa# -> Mantissa# -> Int#+eqMantissa# (Mantissa# a) (Mantissa# b) = eqWord# a b++neMantissa# :: Mantissa# -> Mantissa# -> Int#+neMantissa# (Mantissa# a) (Mantissa# b) = neWord# a b++ltMantissa# :: Mantissa# -> Mantissa# -> Int#+ltMantissa# (Mantissa# a) (Mantissa# b) = ltWord# a b++gtMantissa# :: Mantissa# -> Mantissa# -> Int#+gtMantissa# (Mantissa# a) (Mantissa# b) = gtWord# a b++leMantissa# :: Mantissa# -> Mantissa# -> Int#+leMantissa# (Mantissa# a) (Mantissa# b) = leWord# a b++geMantissa# :: Mantissa# -> Mantissa# -> Int#+geMantissa# (Mantissa# a) (Mantissa# b) = geWord# a b++-- | Addition modulo 1+plusMod1Mantissa# :: Mantissa# -> Mantissa# -> Mantissa#+plusMod1Mantissa# (Mantissa# a) (Mantissa# b) = Mantissa# (plusWord# a b)++-- | Subtraction modulo 1+minusMod1Mantissa# :: Mantissa# -> Mantissa# -> Mantissa#+minusMod1Mantissa# (Mantissa# a) (Mantissa# b) = Mantissa# (minusWord# a b)++-- | The second Int# component is nonzero on overflow+plusWithOverflowMantissa# :: Mantissa# -> Mantissa# -> (# Mantissa#, Int# #)+plusWithOverflowMantissa# (Mantissa# a) (Mantissa# b) = let+  !(# c, i #) = addWordC# a b+  in (# Mantissa# c, i #)++-- | The second Int# component is nonzero on overflow+minusWithOverflowMantissa# :: Mantissa# -> Mantissa# -> (# Mantissa#, Int# #)+minusWithOverflowMantissa# (Mantissa# a) (Mantissa# b) = let+  !(# c, i #) = subWordC# a b+  in (# Mantissa# c, i #)++timesMantissa# :: Mantissa# -> Mantissa# -> Mantissa#+timesMantissa# (Mantissa# a) (Mantissa# b) = let+  !(# c, _ #) = timesWord2# a b+  in Mantissa# c++-- | The user is responsible for ensuring that, when they take+-- dividend/divisor, then the dividend is less than the divisor.+quotMantissa# :: Mantissa# -> Mantissa# -> Mantissa#+quotMantissa# (Mantissa# a) (Mantissa# b) = let+  !(# c, _ #) = quotRemWord2# a 0## b+  in Mantissa# c

@@ -0,0 +1,84 @@+module Numeric.MantissaSpec (spec) where++import Data.Ratio ((%))+import Test.Hspec+import Numeric.Mantissa+++spec :: Spec+spec = do+++  describe "Comparisons" $ do++    let twoSevenths = fromRational (2%7) :: Mantissa+    let sixSevenths = fromRational (6%7) :: Mantissa+    +    it "test == (when true)" $ do+      twoSevenths == twoSevenths `shouldBe` True++    it "test == (when false)" $ do+      twoSevenths == sixSevenths `shouldBe` False++    it "test a <= b (when a < b)" $ do+      twoSevenths <= sixSevenths `shouldBe` True++    it "test a <= b (when a = b)" $ do+      twoSevenths <= twoSevenths `shouldBe` True++    it "test a <= b (when a > b)" $ do+      sixSevenths <= twoSevenths `shouldBe` False++    it "test a >= b (when a < b)" $ do+      twoSevenths >= sixSevenths `shouldBe` False++    it "test a >= b (when a = b)" $ do+      twoSevenths >= twoSevenths `shouldBe` True++    it "test a >= b (when a > b)" $ do+      sixSevenths >= twoSevenths `shouldBe` True++    it "test a < b (when a < b)" $ do+      twoSevenths < sixSevenths `shouldBe` True++    it "test a < b (when a = b)" $ do+      twoSevenths < twoSevenths `shouldBe` False++    it "test a < b (when a > b)" $ do+      sixSevenths < twoSevenths `shouldBe` False++    it "test a > b (when a < b)" $ do+      twoSevenths > sixSevenths `shouldBe` False++    it "test a > b (when a = b)" $ do+      twoSevenths > twoSevenths `shouldBe` False++    it "test a > b (when a > b)" $ do+      sixSevenths > twoSevenths `shouldBe` True++  +  describe "Basic arithmetic" $ do++    it "addition" $ do+      mantissaToFractional (fromRational (1%3) + fromRational (1%5)) `shouldBe`+        (fromRational (8%15) :: Float)+      +    it "subtraction" $ do+      mantissaToFractional (fromRational (1%3) - fromRational (1%5)) `shouldBe`+        (fromRational (2%15) :: Float)+      +    it "addition (with wraparound)" $ do+      mantissaToFractional (fromRational (2%3) + fromRational (4%5)) `shouldBe`+        (fromRational (7%15) :: Float)+      +    it "subtraction (with wraparound)" $ do+      mantissaToFractional (fromRational (1%5) - fromRational (1%3)) `shouldBe`+        (fromRational (13%15) :: Float)+      +    it "multiplication" $ do+      mantissaToFractional (fromRational (1%3) * fromRational (1%5)) `shouldBe`+        (fromRational (1%15) :: Float)+      +    it "division" $ do+      mantissaToFractional (fromRational (1%5) / fromRational (1%3)) `shouldBe`+        (fromRational (3%5) :: Float)

@@ -0,0 +1,2 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+-- Autodiscover spec files