fixed (empty) → 0.1

raw patch · 8 files changed

+262/−0 lines, 8 filesdep +basesetup-changed

Dependencies added: base

Files

• .gitignore +17/−0
• .travis.yml +56/−0
• CHANGELOG.markdown +4/−0
• LICENSE +26/−0
• README.markdown +17/−0
• Setup.lhs +7/−0
• fixed.cabal +32/−0
• src/Numeric/Fixed.hs +103/−0

@@ -0,0 +1,17 @@+dist/+.hsenv/+docs+wiki+TAGS+tags+wip+.DS_Store+.*.swp+.*.swo+*.o+*.hi+*~+*#+.cabal-sandbox/+cabal.sandbox.config+codex.tags

@@ -0,0 +1,56 @@+language: haskell++env:+  - GHCVER=7.4.2+  - GHCVER=7.6.3+  - GHCVER=7.8.3+  - GHCVER=head++matrix:+  allow_failures:+    - env: GHCVER=head++before_install:+  # If $GHCVER is the one travis has, don't bother reinstalling it.+  # We can also have faster builds by installing some libraries with+  # `apt`. If it isn't, install the GHC we want from hvr's PPA along+  # with cabal-1.18.+  - |+    if [ $GHCVER = `ghc --numeric-version` ]; then+      # Try installing some of the build-deps with apt-get for speed.+      travis/cabal-apt-install --enable-tests $MODE+      export CABAL=cabal+    else+      # Install the GHC we want from hvr's PPA+      travis_retry sudo add-apt-repository -y ppa:hvr/ghc+      travis_retry sudo apt-get update+      travis_retry sudo apt-get install cabal-install-1.18 ghc-$GHCVER happy+      export CABAL=cabal-1.18+      export PATH=/opt/ghc/$GHCVER/bin:$PATH+    fi+  # Uncomment whenever hackage is down.+  # - mkdir -p ~/.cabal && cp travis/config ~/.cabal/config && $CABAL update+  - $CABAL update++  # Update happy when building with GHC head+  - |+    if [ $GHCVER = "head" ] || [ $GHCVER = "7.8.3" ]; then+      $CABAL install happy alex+      export PATH=$HOME/.cabal/bin:$PATH+    fi++install:+  - $CABAL install --dependencies-only --enable-tests+  - $CABAL configure --enable-tests $MODE++script:+  - $CABAL build+  - $CABAL test --show-details=always++notifications:+  irc:+    channels:+      - "irc.freenode.org#haskell-lens"+    skip_join: true+    template:+      - "\x0313fixed\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}"

@@ -0,0 +1,4 @@+0.1+---+* Initial release+

@@ -0,0 +1,26 @@+Copyright 2014 Edward Kmett++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.++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.

@@ -0,0 +1,17 @@+fixed+====++[![Build Status](https://secure.travis-ci.org/ekmett/fixed.png?branch=master)](http://travis-ci.org/ekmett/fixed)++This package supplies signed fixed-precision values 15 bits above the decimal, 16 bits below.++These arise commonly in GPU applications and it is chosen to match the GLfixed specification.++Contact Information+-------------------++Contributions and bug reports are welcome!++Please feel free to contact me through github or on the #haskell IRC channel on irc.freenode.net.++-Edward Kmett

@@ -0,0 +1,7 @@+#!/usr/bin/runhaskell+> module Main (main) where++> import Distribution.Simple++> main :: IO ()+> main = defaultMain

@@ -0,0 +1,32 @@+name:          fixed+category:      Numeric+version:       0.1+license:       BSD3+cabal-version: >= 1.8+license-file:  LICENSE+author:        Edward A. Kmett+maintainer:    Edward A. Kmett <ekmett@gmail.com>+stability:     provisional+homepage:      http://github.com/ekmett/fixed+bug-reports:   http://github.com/ekmett/fixed/issues+copyright:     Copyright (C) 2014 Edward A. Kmett+build-type:    Simple+tested-with:   GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.3+synopsis:      Signed 15.16 precision fixed point arithmetic+description:   Signed 15.16 precision fixed point arithmetic++extra-source-files:+  .travis.yml+  .gitignore+  README.markdown+  CHANGELOG.markdown++source-repository head+  type: git+  location: git://github.com/ekmett/fixed.git++library+  hs-source-dirs: src+  build-depends: base >= 4 && < 5+  ghc-options: -Wall -fwarn-tabs -O2+  exposed-modules: Numeric.Fixed

@@ -0,0 +1,103 @@+{-# LANGUAGE CApiFFI, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}+module Numeric.Fixed +  ( Fixed(..)+  , fromFixed+  , toFixed+  ) where++import Data.Bits+import Data.Coerce+import Data.Int+import Data.Ratio+import Data.Typeable+import Foreign.Storable+import Foreign.C.Types++-- | A signed 2s complement 15.16 scale fixed precision number+newtype {-# CTYPE "signed int" #-} Fixed = Fixed { getFixed :: CInt } deriving (Eq,Ord,Typeable,Storable)++fromFixed :: Fixed -> Float+fromFixed (Fixed x) = fromIntegral x / 65536++toFixed :: Float -> Fixed+toFixed x = Fixed $ floor (x * 65536 + 0.5)++instance Show Fixed where+  showsPrec d = showsPrec d . fromFixed++instance Num Fixed where+  (+) = coerce ((+) :: CInt -> CInt -> CInt)+  (-) = coerce ((-) :: CInt -> CInt -> CInt)+  negate = coerce (negate :: CInt -> CInt)+  abs = coerce (abs :: CInt -> CInt)+  signum = coerce (signum :: CInt -> CInt)+  Fixed a * Fixed b = Fixed $ fromIntegral (unsafeShiftR (fromIntegral a * fromIntegral b) 16 :: Int64)+  fromInteger i = Fixed $ unsafeShiftL (fromInteger i) 16++instance Enum Fixed where+  succ (Fixed a) = Fixed (a + 0x10000)+  pred (Fixed a) = Fixed (a - 0x10000)+  fromEnum = truncate+  toEnum a = Fixed (unsafeShiftL (fromIntegral a) 16)+  enumFrom a           = toFixed `map` enumFrom (fromFixed a)+  enumFromTo a b       = toFixed `map` enumFromTo (fromFixed a) (fromFixed b)+  enumFromThen a b     = toFixed `map` enumFromThen (fromFixed a) (fromFixed b)+  enumFromThenTo a b c = toFixed `map` enumFromThenTo (fromFixed a) (fromFixed b) (fromFixed c)++instance Bounded Fixed where+  minBound = Fixed minBound+  maxBound = Fixed maxBound++instance Fractional Fixed where+  Fixed a / Fixed b  = Fixed $ fromIntegral (unsafeShiftL (fromIntegral a) 16 `div` fromIntegral b :: Int64)+  fromRational a = Fixed $ fromInteger (unsafeShiftL (numerator a) 16 `div` denominator a)++instance Real Fixed where+  toRational (Fixed i) = toInteger i % 65536++instance RealFrac Fixed where+  properFraction (Fixed a) +    | a >= 0 = (fromIntegral (unsafeShiftR a 16), Fixed (a .&. 0xffff))+    | otherwise = (negate $ fromIntegral $ unsafeShiftR (negate a) 16, Fixed $ (a .&. 0xffff) - 0x10000)+  truncate (Fixed a) +    | a >= 0 = fromIntegral (unsafeShiftR a 16)+    | otherwise = negate $ fromIntegral $ unsafeShiftR (negate a) 16+  round (Fixed f)   = fromIntegral $ unsafeShiftR (f + 0x800) 16 +  ceiling (Fixed f) = fromIntegral $ unsafeShiftR (f + 0xffff) 16+  floor (Fixed f)   = fromIntegral $ unsafeShiftR f 16++instance Floating Fixed where+  pi = toFixed pi+  exp = toFixed . exp . fromFixed+  sqrt = toFixed . sqrt . fromFixed+  log = toFixed . log . fromFixed+  a ** b = toFixed $ fromFixed a ** fromFixed b+  logBase a b = toFixed $ logBase (fromFixed a) (fromFixed b)+  sin = toFixed . sin . fromFixed+  tan = toFixed . tan . fromFixed+  cos = toFixed . cos . fromFixed+  asin = toFixed . asin . fromFixed+  atan = toFixed . atan . fromFixed+  acos = toFixed . acos . fromFixed+  sinh = toFixed . sinh . fromFixed+  tanh = toFixed . tanh . fromFixed+  cosh = toFixed . cosh . fromFixed+  asinh = toFixed . asinh . fromFixed+  atanh = toFixed . atanh . fromFixed+  acosh = toFixed . acosh . fromFixed++instance RealFloat Fixed where+  floatRadix  _ = 2+  floatDigits _ = 16+  decodeFloat = decodeFloat . fromFixed+  isInfinite _ = False+  isIEEE _ = False+  atan2 a b = toFixed $ atan2 (fromFixed a) (fromFixed b)+  isDenormalized (Fixed a) = a .&. 0x7fff0000 /= 0+  isNaN _ = False+  isNegativeZero _ = False+  floatRange _ = (15,0)+  encodeFloat i j = toFixed $ encodeFloat i j+  exponent = exponent . fromFixed+  significand = toFixed . significand . fromFixed+  scaleFloat n (Fixed a) = Fixed (shift a n)