]> gerrit.simantics Code Review - simantics/platform.git/blob - bundles/org.simantics.scl.runtime/scl/Arbitrary.scl
New parametrisation of OpenDiagramFromConfigurationAdapter.openEditor
[simantics/platform.git] / bundles / org.simantics.scl.runtime / scl / Arbitrary.scl
1 import "Prelude"
2 import "Random"
3 import "IterN"
4 import "Vector" as Vector
5
6 data Gen a = Gen (Integer -> <Random> a)
7
8 @inline
9 genRandom :: (<Random> a) -> Gen a
10 genRandom r = Gen (\_ -> r)
11
12 @inline
13 runGen :: Gen a -> Integer -> <Random> a
14 runGen (Gen f) n = f n
15
16 class Arbitrary a where
17     arbitrary :: Gen a
18
19 class CoArbitrary a where
20     variateSeed :: Integer -> Long -> a -> Long
21
22 instance Arbitrary Boolean where
23     arbitrary = genRandom randomBoolean
24 instance CoArbitrary Boolean where
25     variateSeed _ seed v = if v then seed + 1 else seed
26
27 @private
28 @inline
29 negateRandomly :: Integer -> <Random> Integer
30 negateRandomly v = if randomBoolean then v else -v
31
32 instance Arbitrary Integer where
33     arbitrary = Gen $ \n -> negateRandomly $ randomN $ n+1
34 instance CoArbitrary Integer where
35     variateSeed _ seed v = seed + fromInteger v
36     
37 instance Arbitrary Long where
38     arbitrary = genRandom randomLong
39 instance CoArbitrary Long where
40     variateSeed _ seed v = seed + v
41     
42 instance Arbitrary Float where
43     arbitrary = Gen $ \n -> fromInteger n 
44                           * (fromInteger $ negateRandomly $ randomN $ pres)
45                           / (fromInteger $ 1+randomN pres)
46         where pres = 999999999
47 instance CoArbitrary Float where
48     variateSeed _ seed v = seed + fromInteger (floatToIntBits v)
49
50 instance Arbitrary Double where
51     arbitrary = Gen $ \n -> fromInteger n 
52                           * (fromInteger $ negateRandomly $ randomN $ pres)
53                           / (fromInteger $ 1+randomN pres)
54         where pres = 999999999
55 instance CoArbitrary Double where
56     variateSeed _ seed v = seed + doubleToLongBits v
57
58 randomCharacter :: <Random> Character
59 randomCharacter = let p = randomN 100 
60                   in if p < 80
61                      then addChar ' ' (randomN 95)
62                      else if p < 90
63                      then addChar '\0' (randomN 256)
64                      else addChar '\0' (randomN 65536)
65 randomIdentifierFirstCharacter :: <Random> Character
66 randomIdentifierFirstCharacter = if randomBoolean
67                                  then addChar 'a' (randomN 26)
68                                  else addChar 'A' (randomN 26)
69 randomIdentifierCharacter :: <Random> Character
70 randomIdentifierCharacter = let p = randomN 100 
71                             in if p < 70
72                                then addChar 'a' (randomN 26)
73                                else if p < 90
74                                then addChar 'A' (randomN 26)
75                                else addChar '0' (randomN 10)
76                         
77 instance Arbitrary Character where
78     arbitrary = genRandom randomCharacter
79 instance CoArbitrary Character where
80     variateSeed _ seed v = seed + fromInteger (hashCode (showCharacter v))
81
82 """Generates a random string that is a valid SCL or Java identifier""" 
83 arbitraryIdentifier = Gen $ \n -> string (Vector.vectorF (1+randomN (max n 1))
84     (\i -> if i==0 then randomIdentifierFirstCharacter else randomIdentifierCharacter))
85
86 instance Arbitrary String where
87     arbitrary = Gen $ \n -> string (Vector.vectorF (randomN (1+n)) (\_ -> randomCharacter))
88 instance CoArbitrary String where
89     variateSeed _ seed v = seed + fromInteger (hashCode v)
90
91 instance Arbitrary () where
92     arbitrary = genRandom ()
93 instance CoArbitrary () where
94     variateSeed _ seed _ = seed
95
96 instance (Arbitrary a, Arbitrary b) => Arbitrary (a, b) where
97     arbitrary = arbitraryTuple2 arbitrary arbitrary
98 instance (CoArbitrary a, CoArbitrary b) => CoArbitrary (a, b) where
99     variateSeed n seed (a, b) = variateSeed n (13*variateSeed n seed a) b
100
101 instance (Arbitrary a, Arbitrary b, Arbitrary c) => Arbitrary (a, b, c) where
102     arbitrary = arbitraryTuple3 arbitrary arbitrary arbitrary
103 instance (CoArbitrary a, CoArbitrary b, CoArbitrary c) => CoArbitrary (a, b, c) where
104     variateSeed n seed (a, b, c) = variateSeed n (13*variateSeed n (13*variateSeed n seed a) b) c
105
106 instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d) => Arbitrary (a, b, c, d) where
107     arbitrary = arbitraryTuple4 arbitrary arbitrary arbitrary arbitrary
108 instance (CoArbitrary a, CoArbitrary b, CoArbitrary c, CoArbitrary d) => CoArbitrary (a, b, c, d) where
109     variateSeed n seed (a, b, c, d) = variateSeed n (13*variateSeed n (13*variateSeed n (13*variateSeed n seed a) b) c) d
110
111 instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d, Arbitrary e) => Arbitrary (a, b, c, d, e) where
112     arbitrary = arbitraryTuple5 arbitrary arbitrary arbitrary arbitrary arbitrary
113 instance (CoArbitrary a, CoArbitrary b, CoArbitrary c, CoArbitrary d, CoArbitrary e) 
114       => CoArbitrary (a, b, c, d, e) where
115     variateSeed n seed (a, b, c, d, e) = 
116         variateSeed n (13*variateSeed n (13*variateSeed n (13*variateSeed n (13*variateSeed n seed a) b) c) d) e
117
118 instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d, Arbitrary e, Arbitrary f) 
119       => Arbitrary (a, b, c, d, e, f) where
120     arbitrary = arbitraryTuple6 arbitrary arbitrary arbitrary arbitrary arbitrary arbitrary
121 instance (CoArbitrary a, CoArbitrary b, CoArbitrary c, CoArbitrary d, CoArbitrary e, CoArbitrary f) 
122       => CoArbitrary (a, b, c, d, e, f) where
123     variateSeed n seed (a, b, c, d, e, f) = 
124         variateSeed n (13*variateSeed n (13*variateSeed n (13*variateSeed n (13*variateSeed n (13*variateSeed n seed a) b) c) d) e) f
125
126 instance (Arbitrary a) => Arbitrary (Maybe a) where
127     arbitrary = arbitraryMaybe arbitrary
128 instance (CoArbitrary a) => CoArbitrary (Maybe a) where
129     variateSeed n seed v = match v with
130         Nothing -> 13*seed+1
131         Just a -> 13*variateSeed n seed a
132
133 instance (Arbitrary a, Arbitrary b) => Arbitrary (Either a b) where
134     arbitrary = arbitraryEither arbitrary arbitrary
135 instance (CoArbitrary a, CoArbitrary b) => CoArbitrary (Either a b) where
136     variateSeed n seed v = match v with
137         Left a  -> 13*variateSeed n seed a
138         Right a -> 13*variateSeed n seed a+1
139
140 instance (Arbitrary a) => Arbitrary [a] where
141     arbitrary = arbitraryList arbitrary
142 instance (CoArbitrary a) => CoArbitrary [a] where
143     variateSeed n = foldl (variateSeed n)
144         
145 instance (Arbitrary a, VecComp a) => Arbitrary (Vector a) where
146     arbitrary = arbitraryVector arbitrary
147 instance (CoArbitrary a) => CoArbitrary (Vector a) where
148     variateSeed n = Vector.foldlVector (variateSeed n)
149     
150 instance (CoArbitrary a, Arbitrary b) => Arbitrary (a -> b) where
151     arbitrary = Gen $ \n -> let seed = randomLong
152                             in  \v -> withSeed (variateSeed n seed v) (runGen arbitrary n)
153 instance (Arbitrary a, CoArbitrary b) => CoArbitrary (a -> b) where
154     variateSeed n seed f = variateSeed n seed (withSeed seed (mapList f (runGen arbitrary n)))
155
156 arbitraryTuple2 (Gen a) (Gen b) = Gen $ \n -> (a n, b n)
157
158 arbitraryTuple3 (Gen a) (Gen b) (Gen c) = Gen $ \n -> (a n, b n, c n)
159
160 arbitraryTuple4 (Gen a) (Gen b) (Gen c) (Gen d) = Gen $ \n -> (a n, b n, c n, d n)
161
162 arbitraryTuple5 (Gen a) (Gen b) (Gen c) (Gen d) (Gen e) = Gen $ \n -> (a n, b n, c n, d n, e n)
163
164 arbitraryTuple6 (Gen a) (Gen b) (Gen c) (Gen d) (Gen e) (Gen f) = Gen $ \n -> (a n, b n, c n, d n, e n, f n)
165
166 arbitraryMaybe (Gen f) =
167     Gen $ \n -> if randomN 4 < 1
168                 then Nothing
169                 else Just (f n)
170
171 arbitraryEither (Gen left) (Gen right) =
172     Gen $ \n -> if randomBoolean
173                 then Left (left n)
174                 else Right (right n)
175
176 arbitraryFixedSizeList :: Integer -> Gen a -> Gen [a]
177 arbitraryFixedSizeList s (Gen f) = Gen $ \n -> mapN (\_ -> f n) s
178
179 arbitraryList :: Gen a -> Gen [a]
180 arbitraryList (Gen f) = Gen $ \n -> mapN (\_ -> f n) (randomN n)
181
182 @inline
183 arbitraryFixedSizeVector :: VecComp a => Integer -> Gen a -> Gen (Vector a)
184 arbitraryFixedSizeVector s (Gen f) = Gen $ \n -> Vector.vectorF s (\_ -> f n)
185
186 @inline
187 arbitraryVector :: VecComp a => Gen a -> Gen (Vector a)
188 arbitraryVector (Gen f) = Gen $ \n -> Vector.vectorF (randomN n) (\_ -> f n)
189
190 arbitraryElement :: [a] -> Gen a
191 arbitraryElement elements = genRandom (elements ! randomN (length elements))
192
193 arbitraryResized :: (Integer -> Integer) -> Gen a -> Gen a
194 arbitraryResized f (Gen gen) = Gen (gen . f)