summaryrefslogtreecommitdiff
path: root/testsuite/tests/numeric/should_run/quotRem2.hs
blob: bb7fb6cd12c9d015ebffbd959163429355258b11 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34

{-# LANGUAGE MagicHash, UnboxedTuples #-}

import GHC.Prim
import GHC.Word
import Control.Monad
import Data.Bits

main :: IO ()
main = do f 5 6 23
          f 0x80000000 0 0x80000001
          f 0xFC1D8A3BFB29FC6A 49 0xFD94E3B7FE36FB18

f :: Word -> Word -> Word -> IO ()
f wxHigh@(W# xHigh) wxLow@(W# xLow) wy@(W# y)
    = do when debugging $ putStrLn "-----"
         when debugging $ putStrLn ("Doing " ++ show (wxHigh, wxLow)
                                             ++ " `quotRem` " ++ show wy)
         let ix = (toInteger wxHigh `shiftL` bitSize wxHigh)
              .|. toInteger wxLow
             wanted = ix `quotRem` toInteger wy
         when debugging $ putStrLn ("Wanted: " ++ show wanted)
         case quotRemWord2# xHigh xLow y of
             (# q, r #) ->
                 do let wq = W# q
                        wr = W# r
                        got = (toInteger wq, toInteger wr)
                    when debugging $ putStrLn ("Got: " ++ show got)
                    if wanted == got then putStrLn "Worked"
                                     else putStrLn "Failed"

debugging :: Bool
debugging = False