1
1
mirror of https://github.com/github/semantic.git synced 2024-11-24 08:54:07 +03:00

Make leaves likelier.

This commit is contained in:
Rob Rix 2015-12-11 15:47:23 -05:00
parent 91317207fe
commit 50090dd73a

View File

@ -30,7 +30,7 @@ instance (Eq a, Eq annotation, Arbitrary a, Arbitrary annotation) => Arbitrary (
where boundedTerm m n = ArbitraryTerm <$> ((,) <$> arbitrary <*> boundedSyntax m n)
boundedSyntax _ n | n <= 0 = liftM Leaf arbitrary
boundedSyntax m n = frequency
[ (4, liftM Leaf arbitrary),
[ (6, liftM Leaf arbitrary),
(1, liftM Indexed $ take n <$> listOf (boundedTerm (div m 2) (div n 3))),
(1, liftM Fixed $ take n <$> listOf (boundedTerm (div m 2) (div n 3))),
(1, liftM (Keyed . Map.fromList) $ take n <$> listOf (arbitrary >>= (\x -> ((,) x) <$> boundedTerm (div m 2) (div n 3)))) ]