Ticket #2130: A.hs

{-# OPTIONS -fglasgow-exts #-}

module M where

import Data.Word
import Control.Monad
import GHC.Word
import GHC.Exts

{-
-- This code is fine:

ok :: Word -> Bool
ok c = c < 1

ok' :: Word -> Bool
ok' c | c < 1  = True
      | otherwise = False
-}

-- This code generates ugly results:
-- Int types here are also fine.

bad :: Word -> Bool
bad c | c < 1     = True
      | c < 2     = True
      | otherwise = False

{-

M.$wbad =
  \ (ww_sXC :: GHC.Prim.Word#) ->
    case GHC.Prim.eqWord# ww_sXC __word 1 of wild2_aSC {
      GHC.Base.False ->
        case GHC.Prim.ltWord# ww_sXC __word 1 of wild_B1 {
          GHC.Base.False ->
            case GHC.Prim.eqWord# ww_sXC __word 2 of wild21_XUq {
              GHC.Base.False -> GHC.Prim.ltWord# ww_sXC __word 2;
              GHC.Base.True -> GHC.Base.False
            };
          GHC.Base.True -> GHC.Base.True
        };
      GHC.Base.True ->
        case GHC.Prim.eqWord# ww_sXC __word 2 of wild21_XUo {
          GHC.Base.False -> GHC.Prim.ltWord# ww_sXC __word 2;

-}

------------------------------------------------------------------------

-- Using our own instances for Ord and Eq, based on Int, are also good

good :: MyWord -> Bool
good c | c < 1     = True  -- two comparisons
       | c < 2     = True
       | otherwise = False

{-

M.good =
  \ (c_agn :: M.MyWord) ->
    case c_agn `cast` ((M.:CoMyWord) :: M.MyWord ~ GHC.Word.Word)

    of wild_B1 { GHC.Word.W# x_agV ->
        case GHC.Prim.ltWord# x_agV __word 1 of wild1_X33 {
          GHC.Base.False -> GHC.Prim.ltWord# x_agV __word 2;
          GHC.Base.True -> GHC.Base.True
    }
    }

-}

------------------------------------------------------------------------

-- how is data Word = W# Word# deriving (Eq, Ord) derived??
--
newtype MyWord = MyWord { unWord :: Word }
        deriving (Num,Show, Real,Enum,Integral,Bounded,Read)

instance Eq MyWord where
    (MyWord x) == (MyWord y) = eqWord x y
    (MyWord x) /= (MyWord y) = neWord x y

instance Ord MyWord where
   (MyWord x) `compare` (MyWord y) = compareWord x y
   (MyWord x)  <        (MyWord y) = ltWord x y
   (MyWord x)  <=       (MyWord y) = leWord x y
   (MyWord x)  >=       (MyWord y) = geWord x y
   (MyWord x)  >        (MyWord y) = gtWord x y

compareWord :: Word -> Word -> Ordering
(W# x#) `compareWord` (W# y#) = compareWord# x# y#

compareWord# :: Word# -> Word# -> Ordering
compareWord# x# y#
    | x# `ltWord#` y# = LT
    | x# `eqWord#` y# = EQ
    | otherwise       = GT

gtWord, geWord, eqWord, neWord, ltWord, leWord :: Word -> Word -> Bool
(W# x) `gtWord` (W# y) = x `gtWord#`  y
(W# x) `geWord` (W# y) = x `geWord#` y
(W# x) `eqWord` (W# y) = x `eqWord#` y
(W# x) `neWord` (W# y) = x `neWord#` y
(W# x) `ltWord` (W# y) = x `ltWord#`  y
(W# x) `leWord` (W# y) = x `leWord#` y

{-# INLINE eqWord #-}
{-# INLINE neWord #-}
{-# INLINE gtWord #-}
{-# INLINE geWord #-}
{-# INLINE ltWord #-}
{-# INLINE leWord #-}

------------------------------------------------------------------------