Skip to content

Commit

Permalink
Avoid -Wx-partial warnings
Browse files Browse the repository at this point in the history
These were uncovered by GHC 9.8, where -Wx-partial is included in -Wall.
  • Loading branch information
RyanGlScott committed Aug 8, 2023
1 parent 2de96b1 commit 072c8ce
Show file tree
Hide file tree
Showing 5 changed files with 35 additions and 12 deletions.
9 changes: 6 additions & 3 deletions data-reify.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -121,7 +121,8 @@ Executable data-reify-test3
Executable data-reify-test4
Build-Depends: base, data-reify
Main-Is: Test4.hs
Hs-Source-Dirs: test
other-modules: Common
Hs-Source-Dirs: test, test-common
ghc-options: -Wall
default-language: Haskell2010
if !flag(tests)
Expand All @@ -130,7 +131,8 @@ Executable data-reify-test4
Executable data-reify-test5
Build-Depends: base, data-reify
Main-Is: Test5.hs
Hs-Source-Dirs: test
other-modules: Common
Hs-Source-Dirs: test, test-common
ghc-options: -Wall
default-language: Haskell2010
if !flag(tests)
Expand All @@ -139,7 +141,8 @@ Executable data-reify-test5
Executable data-reify-test6
Build-Depends: base, data-reify
Main-Is: Test6.hs
Hs-Source-Dirs: test
other-modules: Common
Hs-Source-Dirs: test, test-common
ghc-options: -Wall
default-language: Haskell2010
if !flag(tests)
Expand Down
15 changes: 15 additions & 0 deletions test-common/Common.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,15 @@
module Common (head_, tail_) where

-- | Like 'head', but with a more specific error message in case the argument is
-- empty. This is primarily defined to avoid incurring @-Wx-partial@ warnings
-- whenever 'head' is used.
head_ :: [a] -> a
head_ (x:_) = x
head_ [] = error "head_: Empty list"

-- | Like 'tail', but with a more specific error message in case the argument is
-- empty. This is primarily defined to avoid incurring @-Wx-partial@ warnings
-- whenever 'tail' is used.
tail_ :: [a] -> [a]
tail_ (_:xs) = xs
tail_ [] = error "tail_: Empty list"
9 changes: 5 additions & 4 deletions test/Test4.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Main (main) where

import Common
import Control.Applicative hiding (Const)
import Data.Reify
import System.CPUTime
Expand All @@ -12,11 +13,11 @@ data List a b = Nil | Cons a b


instance MuRef [a] where
type DeRef [a] = List a
type DeRef [a] = List a

mapDeRef f (x:xs) = Cons x <$> f xs
mapDeRef _ [] = pure Nil

instance Functor (List a) where
fmap _ Nil = Nil
fmap f (Cons a b) = Cons a (f b)
Expand All @@ -32,7 +33,7 @@ main = do

-- now, some timings.
ns <- sequence [ timeme n | n <- take 8 (iterate (*2) 1024) ]
print $ reverse $ take 4 $ reverse [ n2 / n1 | (n1,n2) <- zip ns (tail ns) ]
print $ reverse $ take 4 $ reverse [ n2 / n1 | (n1,n2) <- zip ns (tail_ ns) ]

timeme :: Int -> IO Float
timeme n = do
Expand All @@ -42,5 +43,5 @@ timeme n = do
j <- getCPUTime
let n' :: Float
n' = fromIntegral ((j - i) `div` 1000000000)
putStrLn $ " ==> " ++ show (n' / 1000)
putStrLn $ " ==> " ++ show (n' / 1000)
return n'
8 changes: 5 additions & 3 deletions test/Test5.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,8 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Main (main) where

import Common

import Control.Applicative hiding (Const)

import Data.Dynamic
Expand All @@ -15,7 +17,7 @@ data List a b = Nil | Cons a b
deriving Show

instance Typeable a => MuRef [a] where
type DeRef [a] = List a
type DeRef [a] = List a

mapDeRef f (x:xs) = Cons x <$> f xs
mapDeRef _ [] = pure Nil
Expand All @@ -34,7 +36,7 @@ main = do

-- now, some timings.
ns <- sequence [ timeme n | n <- take 8 (iterate (*2) 1024) ]
print $ reverse $ take 4 $ reverse [ n2 / n1 | (n1,n2) <- zip ns (tail ns) ]
print $ reverse $ take 4 $ reverse [ n2 / n1 | (n1,n2) <- zip ns (tail_ ns) ]

timeme :: Int -> IO Float
timeme n = do
Expand All @@ -44,5 +46,5 @@ timeme n = do
j <- getCPUTime
let n' :: Float
n' = fromIntegral ((j - i) `div` 1000000000)
putStrLn $ " ==> " ++ show (n' / 1000)
putStrLn $ " ==> " ++ show (n' / 1000)
return n'
6 changes: 4 additions & 2 deletions test/Test6.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,8 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Main (main) where

import Common

import Control.Applicative hiding (Const)

import Data.Dynamic
Expand Down Expand Up @@ -76,12 +78,12 @@ main = do
g2 = [1..10] ++ g2
reifyGraph g2 >>= print

let g3 = [\ x -> x :: Exp, \ y -> y + head g3 2] ++ g3
let g3 = [\ x -> x :: Exp, \ y -> y + head_ g3 2] ++ g3
reifyGraph g3 >>= print

-- now, some timings.
ns <- sequence [ timeme n | n <- take 8 (iterate (*2) 1024) ]
print $ reverse $ take 4 $ reverse [ n2 / n1 | (n1,n2) <- zip ns (tail ns) ]
print $ reverse $ take 4 $ reverse [ n2 / n1 | (n1,n2) <- zip ns (tail_ ns) ]

-- zz :: [[Int]]
-- zz = let xs = [1..3]
Expand Down

0 comments on commit 072c8ce

Please sign in to comment.