Propagate evaluated-ness a bit more faithfully
[ghc.git] / testsuite / tests / simplCore / should_compile / T13027.hs
1 {-# LANGUAGE BangPatterns #-}
2 {-# LANGUAGE MagicHash #-}
3 module T13027 (insert) where
4
5 import GHC.Exts (isTrue#, reallyUnsafePtrEquality#)
6
7 data Set a = Bin {-# UNPACK #-} !Size !a !(Set a) !(Set a)
8 | Tip
9
10 type Size = Int
11
12 insert :: Ord a => a -> Set a -> Set a
13 insert = go
14 where
15 go :: Ord a => a -> Set a -> Set a
16 go !x Tip = Bin 1 x Tip Tip
17 go !x t@(Bin sz y l r) = case compare x y of
18 LT | l' `ptrEq` l -> t
19 | otherwise -> undefined -- balanceL y l' r
20 where !l' = go x l
21 GT | r' `ptrEq` r -> t
22 | otherwise -> undefined -- balanceR y l r'
23 where !r' = go x r
24 EQ | x `ptrEq` y -> t
25 | otherwise -> Bin sz x l r
26 {-# INLINABLE insert #-}
27
28 ptrEq :: a -> a -> Bool
29 ptrEq x y = isTrue# (reallyUnsafePtrEquality# x y)
30 {-# INLINE ptrEq #-}