Documentation for (&&) and (&&) states that they are lazy in their second argument...
[ghc.git] / testsuite / tests / typecheck / should_compile / T11397.hs
1 module T11397 where
2
3
4 f :: a -> [Maybe a]
5 f x =
6 let switch l = [l Nothing, l (Just x)]
7 in switch id
8
9 u :: a
10 u = u
11
12 f2 :: a
13 f2 = let switch l = l u in switch u
14
15
16 f3 :: a
17 f3 = let switch l = l undefined in switch undefined
18
19
20 newtype VectorLazy a = VectorLazy a
21 newtype Vector a = Vector a
22 newtype Pointer a = Pointer a
23
24 empty :: VectorLazy a
25 empty = undefined
26
27 cons :: Vector a -> Pointer a
28 cons = undefined
29
30 unfoldrResult :: (a -> Either c (b, a)) -> a -> (VectorLazy b, c)
31 unfoldrResult = undefined
32
33 switchL :: b -> (a -> Pointer a -> b) -> Pointer a -> b
34 switchL = undefined
35
36 inverseFrequencyModulationChunk ::
37 (Num t, Ord t) =>
38 (s -> Maybe (t,s)) -> (t,s) -> Vector v -> (VectorLazy v, Maybe (t,s))
39 inverseFrequencyModulationChunk nextC (phase,cst0) chunk =
40 let {-
41 switch ::
42 (Maybe (t, s) -> r) ->
43 ((t, v) -> (s, Pointer v) -> r) ->
44 t ->
45 (s, Pointer v) -> r
46 -}
47 switch l r t (cp0,xp0) =
48 maybe
49 (l Nothing)
50 (\(c1,cp1) ->
51 switchL
52 (l (Just (t,cp0)))
53 (\x1 xp1 -> r (t+c1,x1) (cp1,xp1))
54 xp0)
55 (nextC cp0)
56
57 {-
58 go ::
59 (t,v) -> (s, Pointer v) ->
60 Either (Maybe (t,s)) (v, ((t,v), (s, Pointer v)))
61 -}
62 go (c,x) cxp =
63 if c<1
64 then switch Left go c cxp
65 else Right (x, ((c-1,x),cxp))
66
67 in switch ((,) empty)
68 (curry $ unfoldrResult (uncurry go))
69 phase (cst0, cons chunk)