fixes for GHC 9.4.6. (#1)

* fixes for GHC 9.4.6.

* support 64 bit systems older than ghc 9.4

* add check for ghc 9.4.1+.

* add check for 32 bit ghc 9.4.1+.

* move definitions under copyright.

* Add CI

* Testsuite fixes

* try

* fixup! try

* Fix testsuite warnings (#3)

---------

Co-authored-by: Richard Marko <srk@48.io>

.github/workflows/ci.dhall

@@ -0,0 +1,17 @@
+let haskellCi =
+      https://raw.githubusercontent.com/sorki/github-actions-dhall/main/haskell-ci.dhall
+
+in    haskellCi.generalCi
+        haskellCi.defaultCabalSteps
+        haskellCi.DhallMatrix::{
+        , ghc =
+          [ haskellCi.GHC.GHC963
+          , haskellCi.GHC.GHC947
+          , haskellCi.GHC.GHC928
+          , haskellCi.GHC.GHC8107
+          , haskellCi.GHC.GHC884
+          ]
+        , cabal = [ haskellCi.Cabal.Cabal310, haskellCi.Cabal.Cabal34 ]
+        , os = [ haskellCi.OS.Ubuntu2204, haskellCi.OS.Ubuntu2004 ]
+        }
+    : haskellCi.CI.Type

.github/workflows/ci.sh

@@ -0,0 +1,12 @@
+#!/usr/bin/env bash
+# Script by @fisx
+
+set -eo pipefail
+
+# cd into the dir where this script is placed
+cd "$( dirname "${BASH_SOURCE[0]}" )"
+
+echo "regenerating .github/workflows/ci.yaml"
+
+which dhall-to-yaml-ng || cabal install dhall-yaml
+dhall-to-yaml-ng --generated-comment --file ci.dhall > ci.yaml

.github/workflows/ci.yaml

@@ -0,0 +1,57 @@
+# Code generated by dhall-to-yaml.  DO NOT EDIT.
+jobs:
+  build:
+    name: "GHC ${{ matrix.ghc }}, Cabal ${{ matrix.cabal }}, OS ${{ matrix.os }}"
+    "runs-on": "${{ matrix.os }}"
+    steps:
+    - uses: "actions/checkout@v4"
+      with:
+        submodules: recursive
+    - id: "setup-haskell-cabal"
+      uses: "haskell-actions/setup@v2"
+      with:
+        "cabal-version": "${{ matrix.cabal }}"
+        "ghc-version": "${{ matrix.ghc }}"
+    - name: Update Hackage repository
+      run: cabal update
+    - name: cabal.project.local.ci
+      run: |
+        if [ -e cabal.project.local.ci ]; then
+          cp cabal.project.local.ci cabal.project.local
+        fi
+    - name: freeze
+      run: "cabal freeze --enable-tests --enable-benchmarks"
+    - uses: "actions/cache@v3"
+      with:
+        key: "${{ matrix.os }}-${{ matrix.ghc }}-${{ matrix.cabal}}-${{ hashFiles('cabal.project.freeze') }}"
+        path: |
+          ${{ steps.setup-haskell-cabal.outputs.cabal-store }}
+          dist-newstyle
+    - name: Install dependencies
+      run: "cabal build all --enable-tests --enable-benchmarks --only-dependencies"
+    - name: build all
+      run: "cabal build all --enable-tests --enable-benchmarks"
+    - name: test all
+      run: "cabal test all --enable-tests"
+    - name: haddock all
+      run: cabal haddock all
+    strategy:
+      matrix:
+        cabal:
+        - '3.10'
+        - '3.4'
+        ghc:
+        - '9.6.3'
+        - '9.4.7'
+        - '9.2.8'
+        - '8.10.7'
+        - '8.8.4'
+        os:
+        - "ubuntu-22.04"
+        - "ubuntu-20.04"
+name: Haskell CI
+'on':
+  pull_request: {}
+  push: {}
+  schedule:
+  - cron: "4 20 10 * *"

src/Data/Bits/Floating.hs

@@ -61,7 +61,6 @@ class (Floating f, Integral w) => FloatingBits f w | f -> w where
     --   If @x@ is not NaN, @'ulp' x == 'ulp' (-x)@ holds.
     ulp :: f -> f
 
-
 class ShowFloat f where
     {-# MINIMAL showsFloat | showFloat #-}
     -- | Like 'showFloat', but prepends the value to another string.
@@ -72,7 +71,7 @@ class ShowFloat f where
     showFloat :: f -> String
     showFloat f = showsFloat f ""
 
-{-# RULES "showFloat/++" forall f s . showFloat f ++ s = showsFloat f s #-}
+-- {-# RULES "showFloat/++" forall f s . showFloat f ++ s = showsFloat f s #-}
 
 instance FloatingBits Float Word32 where
     {-# INLINE coerceToWord #-}

src/Data/Bits/Floating/Prim.hs

@@ -1,8 +1,3 @@
-{-# LANGUAGE ForeignFunctionInterface #-}
-{-# LANGUAGE MagicHash                #-}
-{-# LANGUAGE GHCForeignImportPrim     #-}
-{-# LANGUAGE UnliftedFFITypes         #-}
-{-# LANGUAGE CPP                      #-}
 -----------------------------------------------------------------------------
 -- |
 -- Copyright   :  (C) 2015 Anselm Jonas Scholl
@@ -16,31 +11,56 @@
 -- boxed values.
 ----------------------------------------------------------------------------
 
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE MagicHash                #-}
+{-# LANGUAGE GHCForeignImportPrim     #-}
+{-# LANGUAGE UnliftedFFITypes         #-}
+{-# LANGUAGE CPP                      #-}
+
 #include "MachDeps.h"
 
 module Data.Bits.Floating.Prim where
 
 import GHC.Exts
 import GHC.Word
 
+#if MIN_VERSION_base(4,17,0)
+-- The name of Word# changed to Word64# in ghc 9.4.1
+#define WORD64 Word64
+#define WORD32 Word32
+#else
+#define WORD64 Word
+#define WORD32 Word
+#endif
+
 #if WORD_SIZE_IN_BITS == 64
 foreign import prim "double2WordBwzh"
-    double2WordBitwise# :: Double# -> Word#
+    double2WordBitwise# :: Double# -> WORD64#
 foreign import prim "word2DoubleBwzh"
-    word2DoubleBitwise# :: Word# -> Double#
+    word2DoubleBitwise# :: WORD64# -> Double#
 #elif WORD_SIZE_IN_BITS == 32
 foreign import prim "double2WordBwzh"
-    double2WordBitwise# :: Double# -> Word64#
+    double2WordBitwise# :: Double# -> WORD32#
 foreign import prim "word2DoubleBwzh"
-    word2DoubleBitwise# :: Word64# -> Double#
+    word2DoubleBitwise# :: WORD32# -> Double#
 #else
 #error "Unsupported word size"
 #endif
 
+#undef WORD64
+#undef WORD32
+
+#if MIN_VERSION_base(4,15,0)
+foreign import prim "float2WordBwzh"
+    float2WordBitwise# :: Float# -> Word32#
+foreign import prim "word2FloatBwzh"
+    word2FloatBitwise# :: Word32# -> Float#
+#else
 foreign import prim "float2WordBwzh"
     float2WordBitwise# :: Float# -> Word#
 foreign import prim "word2FloatBwzh"
     word2FloatBitwise# :: Word# -> Float#
+#endif
 
 -- | Convert a 'Double' to a 'Word64' while preserving the bit-pattern.
 {-# INLINE double2WordBitwise #-}
@@ -61,3 +81,4 @@ float2WordBitwise (F# f) = W32# (float2WordBitwise# f)
 {-# INLINE word2FloatBitwise #-}
 word2FloatBitwise :: Word32 -> Float
 word2FloatBitwise (W32# w) = F# (word2FloatBitwise# w)
+

test/Test.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 module Main where
 
 import TestUtils
@@ -29,18 +30,28 @@ debug = False
 --   test if coercion between these values works.
 {-# SPECIALIZE testCoercion :: (Float, Word32) -> IO () #-}
 {-# SPECIALIZE testCoercion :: (Double, Word64) -> IO () #-}
-testCoercion :: (Show f, Show w, Integral w, RealFloat f, FloatingBits f w, Monad m) => (f, w) -> m ()
+testCoercion
+  :: forall f w m
+   . ( Show f
+     , Show w
+     , Integral w
+     , RealFloat f
+     , FloatingBits f w
+     , MonadFail m
+     )
+  => (f, w)
+  -> m ()
 testCoercion (f, w) = do
-    let w'  = coerceToWord f
-        f'  = coerceToFloat w
-        w'' = coerceToWord f'
+    let w'  = (coerceToWord :: f -> w) f
+        f'  = (coerceToFloat :: w -> f)  w
+        w'' = (coerceToWord :: f -> w) f'
     unless (w' == w) $ failTest (show f) (showW w) (showW w')
     unless (f' `eqFloat` f) $ failTest (showW w) (show f) (show f')
     unless (w'' == w) $ failTest (show f') (showW w) (showW w'')
 
 -- | Called when a conversion fails.
 {-# SPECIALIZE failTest :: String -> String -> String -> IO () #-}
-failTest :: Monad m => String -> String -> String -> m ()
+failTest :: MonadFail m => String -> String -> String -> m ()
 failTest from wanted got = fail $ "Conversion from " ++ from ++ " to " ++ wanted ++ " failed. Got " ++ got
 
 -- | Check if two floats are really equal: Not only equal as defined by the IEEE
@@ -113,7 +124,7 @@ go cpus cur = do
     unless (maxBound - cur < cpus) $ go cpus (cur + cpus)
 
 {-# SPECIALIZE doTest :: Word32 -> IO () #-}
-doTest :: Monad m => Word32 -> m ()
+doTest :: MonadFail m => Word32 -> m ()
 doTest w = do
     -- test coercions
     let !refFloat   = refWordToFloat w :: Float
@@ -153,7 +164,17 @@ doTest w = do
 
 {-# SPECIALIZE INLINE testNextPrev :: (Float -> Float) -> (Float -> Float) -> Float -> IO () #-}
 {-# SPECIALIZE INLINE testNextPrev :: (Double -> Double) -> (Double -> Double) -> Double -> IO () #-}
-testNextPrev :: (Monad m, RealFloat f, FloatingBits f w, Show f, HasNaN f) => (f -> f) -> (f -> f) -> f -> m ()
+testNextPrev
+  :: ( MonadFail m
+     , RealFloat f
+     , FloatingBits f w
+     , Show f
+     , ShowFloat f
+     )
+  => (f -> f)
+  -> (f -> f)
+  -> f
+  -> m ()
 testNextPrev refNextUp refNextDown testFloat = do
     let !refNextFloat = refNextUp testFloat
         !refPrevFloat = refNextDown testFloat
@@ -181,7 +202,7 @@ testNextPrev refNextUp refNextDown testFloat = do
 {-# SPECIALIZE testAssert :: String -> Float -> Float -> (Float -> Float -> Bool) -> String -> String -> IO () #-}
 {-# SPECIALIZE testAssert :: String -> Word64 -> Word64 -> (Word64 -> Word64 -> Bool) -> String -> String -> IO () #-}
 {-# SPECIALIZE testAssert :: String -> Double -> Double -> (Double -> Double -> Bool) -> String -> String -> IO () #-}
-testAssert :: (Monad m, Show a) => String -> a -> a -> (a -> a -> Bool) -> String -> String -> m ()
+testAssert :: (MonadFail m, Show a) => String -> a -> a -> (a -> a -> Bool) -> String -> String -> m ()
 testAssert ts a b f s s2 = unless (f a b) $
     fail $ "Assert failed: " ++ show a ++ " " ++ s ++ " " ++ show b ++ ": " ++ s2 ++ " (" ++ ts ++ ")"
 

test/TestUtils.hs

@@ -2,7 +2,6 @@
 module TestUtils where
 
 import Data.Word
-import Data.Bits
 
 import Numeric