5 import qualified Data

.Vector

as DV

6 import qualified Data

.Vector

.Generic

as DVG

7 import qualified Data

.Vector

.Primitive

as DVP

8 import qualified Data

.Vector

.Fusion

.Stream

as S

10 import Data

.List

( sortBy )
13 instance Show a

=> Show (S

.Stream a

) where
14 show s

= "Data.Vector.Fusion.Stream.fromList " ++ show (S

.toList s

)
17 instance Arbitrary a

=> Arbitrary

(DV

.Vector a

) where
18 arbitrary

= fmap DV

.fromList arbitrary

19 coarbitrary

= coarbitrary

. DV

.toList

21 instance (Arbitrary a

, DVP

.Prim a

) => Arbitrary

(DVP

.Vector a

) where
22 arbitrary

= fmap DVP

.fromList arbitrary

23 coarbitrary

= coarbitrary

. DVP

.toList

25 instance Arbitrary a

=> Arbitrary

(S

.Stream a

) where
26 arbitrary

= fmap S

.fromList arbitrary

27 coarbitrary

= coarbitrary

. S

.toList

30 class Model a b | a

-> b

where
31 -- | Convert a concrete value into an abstract model
34 -- The meat of the models
35 instance Model

(DV

.Vector a

) [a

] where model

= DV

.toList

36 instance DVP

.Prim a

=> Model

(DVP

.Vector a

) [a

] where model

= DVP

.toList

39 instance Model

Bool Bool where model

= id
40 instance Model

Int Int where model

= id
41 instance Model

Float Float where model

= id
42 instance Model

Double Double where model

= id
43 instance Model

Ordering Ordering where model

= id
46 -- All of these need UndecidableInstances although they are actually well founded. Oh well.
47 instance Model a b

=> Model

(Maybe a

) (Maybe b

) where model

= fmap model

48 instance Model a b

=> Model

[a

] [b

] where model

= fmap model

49 instance (Model a a

', Model b b

') => Model

(a

, b

) (a

', b

') where model

(a

, b

) = (model a

, model b

)
50 instance (Model a a

', Model b b

', Model c c

') => Model

(a

, b

, c

) (a

', b

', c

') where model

(a

, b

, c

) = (model a

, model b

, model c

)
51 instance (Model c a

, Model b d

) => Model

(a

-> b

) (c

-> d

) where model f

= model

. f

. model

54 eq0 f g

= model f

== g

55 eq1 f g

= \a -> model

(f a

) == g

(model a

)
56 eq2 f g

= \a b

-> model

(f a b

) == g

(model a

) (model b

)
57 eq3 f g

= \a b c

-> model

(f a b c

) == g

(model a

) (model b

) (model c

)
58 eq4 f g

= \a b c d

-> model

(f a b c d

) == g

(model a

) (model b

) (model c

) (model d

)
60 eqNotNull1 f g

= \a -> (not (DVG

.null a

)) ==> eq1 f g a

61 eqNotNull2 f g

= \a b

-> (not (DVG

.null b

)) ==> eq2 f g a b

62 eqNotNull3 f g

= \a b c

-> (not (DVG

.null c

)) ==> eq3 f g a b c

63 eqNotNull4 f g

= \a b c d

-> (not (DVG

.null d

)) ==> eq4 f g a b c d

66 index_value_pairs

:: Arbitrary a

=> Int -> Gen

[(Int,a

)]
67 index_value_pairs

0 = return []
68 index_value_pairs m

= sized

$ \n ->
71 is

<- sequence [choose

(0,m

-1) | i

<- [1..len

]]
75 indices :: Int -> Gen

[Int]
77 indices m

= sized

$ \n ->
80 sequence [choose

(0,m

-1) | i

<- [1..len

]]
83 -- Additional list functions
86 slice xs i n

= take n

(drop i xs

)
87 backpermute xs is

= map (xs

!!) is

88 prescanl f z

= init . scanl f z

89 postscanl f z

= tail . scanl f z

91 accum :: (a

-> b

-> a

) -> [a

] -> [(Int,b

)] -> [a

]
92 accum f xs ps

= go xs ps

' 0
94 ps

' = sortBy (\p q

-> compare (fst p

) (fst q

)) ps

96 go

(x

:xs

) ((i

,y

) : ps

) j

97 | i

== j

= go

(f x y

: xs

) ps j

98 go

(x

:xs

) ps j

= x

: go xs ps

(j

+1)
101 (//) :: [a

] -> [(Int, a

)] -> [a

]
102 xs

// ps

= go xs ps

' 0
104 ps

' = sortBy (\p q

-> compare (fst p

) (fst q

)) ps

106 go

(x

:xs

) ((i

,y

) : ps

) j

107 | i

== j

= go

(y

:xs

) ps j

108 go

(x

:xs

) ps j

= x

: go xs ps

(j

+1)