github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-25 07:55:12 +03:00
Code Issues Projects Releases Wiki Activity

Rename n to maxDepth.

Browse Source
This commit is contained in:
Rob Rix 2015-12-14 15:18:16 -05:00
parent 686325bf4c
commit 32d460bce7
1 changed files with 7 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
test/Spec.hs
View File

@ -28,14 +28,14 @@ unTerm arbitraryTerm = unfold unpack arbitraryTerm
instance (Eq a, Eq annotation, Arbitrary a, Arbitrary annotation) => Arbitrary (ArbitraryTerm a annotation) where
arbitrary = sized (\ x -> boundedTerm x x) -- first indicates the cube of the max length of lists, second indicates the cube of the max depth of the tree
where boundedTerm maxLength n = ArbitraryTerm <$> ((,) <$> arbitrary <*> boundedSyntax maxLength n)
boundedSyntax _ n | n <= 0 = liftM Leaf arbitrary
boundedSyntax maxLength n = frequency
where boundedTerm maxLength maxDepth = ArbitraryTerm <$> ((,) <$> arbitrary <*> boundedSyntax maxLength maxDepth)
boundedSyntax _ maxDepth | maxDepth <= 0 = liftM Leaf arbitrary
boundedSyntax maxLength maxDepth = frequency
[ (12, liftM Leaf arbitrary),
(1, liftM Indexed $ take maxLength <$> listOf (smallerTerm maxLength n)),
(1, liftM Fixed $ take maxLength <$> listOf (smallerTerm maxLength n)),
(1, liftM (Keyed . Map.fromList) $ take n <$> listOf (arbitrary >>= (\x -> ((,) x) <$> smallerTerm maxLength n))) ]
smallerTerm maxLength n = boundedTerm (div maxLength 3) (div n 3)
(1, liftM Indexed $ take maxLength <$> listOf (smallerTerm maxLength maxDepth)),
(1, liftM Fixed $ take maxLength <$> listOf (smallerTerm maxLength maxDepth)),
(1, liftM (Keyed . Map.fromList) $ take maxDepth <$> listOf (arbitrary >>= (\x -> ((,) x) <$> smallerTerm maxLength maxDepth))) ]
smallerTerm maxLength maxDepth = boundedTerm (div maxLength 3) (div maxDepth 3)
shrink term@(ArbitraryTerm (annotation, syntax)) = (++) (subterms term) $ filter (/= term) $
ArbitraryTerm <$> ((,) <$> shrink annotation <*> case syntax of
Leaf a -> Leaf <$> shrink a