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)