summaryrefslogtreecommitdiff
path: root/testsuite/tests/typecheck/should_compile/T11397.hs
blob: 6e8a9394727d0f2cc7dfe553af8644b84d9d6c60 (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
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
module T11397 where


f :: a -> [Maybe a]
f x =
   let switch l = [l Nothing, l (Just x)]
   in  switch id

u :: a
u = u

f2 :: a
f2 = let switch l = l u in switch u


f3 :: a
f3 = let switch l = l undefined in switch undefined


newtype VectorLazy a = VectorLazy a
newtype Vector a = Vector a
newtype Pointer a = Pointer a

empty :: VectorLazy a
empty = undefined

cons :: Vector a -> Pointer a
cons = undefined

unfoldrResult :: (a -> Either c (b, a)) -> a -> (VectorLazy b, c)
unfoldrResult = undefined

switchL :: b -> (a -> Pointer a -> b) -> Pointer a -> b
switchL = undefined

inverseFrequencyModulationChunk ::
   (Num t, Ord t) =>
   (s -> Maybe (t,s)) -> (t,s) -> Vector v -> (VectorLazy v, Maybe (t,s))
inverseFrequencyModulationChunk nextC (phase,cst0) chunk =
   let {-
       switch ::
          (Maybe (t, s) -> r) ->
          ((t, v) -> (s, Pointer v) -> r) ->
          t ->
          (s, Pointer v) -> r
       -}
       switch l r t (cp0,xp0) =
          maybe
             (l Nothing)
             (\(c1,cp1) ->
                switchL
                   (l (Just (t,cp0)))
                   (\x1 xp1 -> r (t+c1,x1) (cp1,xp1))
                   xp0)
             (nextC cp0)

       {-
       go ::
          (t,v) -> (s, Pointer v) ->
          Either (Maybe (t,s)) (v, ((t,v), (s, Pointer v)))
       -}
       go (c,x) cxp =
          if c<1
            then switch Left go c cxp
            else Right (x, ((c-1,x),cxp))

   in  switch ((,) empty)
          (curry $ unfoldrResult (uncurry go))
          phase (cst0, cons chunk)