github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-28 01:47:01 +03:00
Code Issues Projects Releases Wiki Activity

Make leaves likelier.

Browse Source
This commit is contained in:
Rob Rix 2015-12-11 15:47:23 -05:00
parent 91317207fe
commit 50090dd73a
1 changed files with 1 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
test/Spec.hs
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) where boundedTerm m n = ArbitraryTerm <$> ((,) <$> arbitrary <*> boundedSyntax m n)
boundedSyntax _ n | n <= 0 = liftM Leaf arbitrary boundedSyntax _ n | n <= 0 = liftM Leaf arbitrary
boundedSyntax m n = frequency 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 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 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)))) ] (1, liftM (Keyed . Map.fromList) $ take n <$> listOf (arbitrary >>= (\x -> ((,) x) <$> boundedTerm (div m 2) (div n 3)))) ]