packages feed

testing-feat 0.3.0.1 → 0.4

raw patch · 8 files changed

+98/−59 lines, 8 files

Files

Test/Feat.hs view
@@ -15,6 +15,7 @@   -- * Accessing data   optimal,   index,+  select,   values,   bounded,   uniform,
Test/Feat/Access.hs view
@@ -4,6 +4,7 @@ module Test.Feat.Access(   -- ** Accessing functions   index,+  select,   values,   striped,   bounded,@@ -26,6 +27,8 @@   toSeries,      -- ** Non-class versions of the access functions+  indexWith,+  selectWith,   valuesWith,   stripedWith,   boundedWith,@@ -45,14 +48,18 @@ -- import Test.SmallCheck.Series -- Not needed  --- | Mainly as a proof of concept (if this is repeated multiple times it might --- be very inefficient, depending on whether the dictionary for the Enumerable --- is shared or not) we define a function to index into an enumeration.+-- | Mainly as a proof of concept we define a function to index into+-- an enumeration. (If this is repeated multiple times it might be+-- very inefficient, depending on whether the dictionary for the+-- Enumerable is shared or not.) index :: Enumerable a => Integer -> a -index i0 = go (parts optimal) i0 where-  go (Finite crd ix : ps)  i  = if i < crd then ix i else go ps (i-crd)-  go []                    _  = error $ "index out of bounds: "++show i0+index = indexWith optimal +-- | A more fine grained version of index that takes a size and an +-- index into the values of that size. @select p i@ is only defined for @i@ +select :: Enumerable a => Int -> Index -> a+select = selectWith optimal+ -- | All values of the enumeration by increasing cost (which is the number -- of constructors for most types). Also contains the cardinality of each list. values :: Enumerable a => [(Integer,[a])]@@ -133,6 +140,19 @@ -- | Compatibility with SmallCheck.  toSeries :: Enumerable a => Int -> [a]  toSeries = toSeriesWith optimal+++-- | Non class version of 'index'.+indexWith :: Enumerate a -> Integer -> a+indexWith e i0 = go (parts e) i0 where+  go (Finite crd ix : ps)  i  = if i < crd then ix i else go ps (i-crd)+  go []                    _  = error $ "index out of bounds: "++show i0+++-- | Non class version of 'select'+selectWith :: Enumerate a -> Int -> Index -> a+selectWith e p i = fIndex (parts e  !! p) i+  -- | Non class version of 'values'. valuesWith :: Enumerate a -> [(Integer,[a])]
Test/Feat/Class.hs view
@@ -269,7 +269,7 @@ instance Enumerable Float where   enumerate = unary (funcurry encodeFloat) --- This should be fixed with a bijective funtion.+-- This should be fixed with a bijective function. -- | Not injective instance (Infinite a, Enumerable a) => Enumerable (Ratio a) where   enumerate = unary $ funcurry $ \a b -> a % nonZero b
Test/Feat/Enumerate.hs view
@@ -35,7 +35,8 @@   tag,   eShare,   noOptim,-  optimise  +  optimise,+  irregular    ) where @@ -50,7 +51,7 @@ import Data.Typeable import Language.Haskell.TH import Data.List(transpose)-+import Control.Monad.State -- TODO: remove direct dependency on mtl   type Part = Int@@ -60,8 +61,8 @@ -- @t@ into finite numbered sets called Parts. Each parts contains values -- of a certain cost (typically the size of the value). data Enumerate a = Enumerate -   { revParts :: RevList (Finite a)-   , optimiser ::  Sharing Tag (Enumerate a) -- Should be RevList a?+   { revParts   ::  RevList (Finite a)+   , optimiser  ::  Sharing Tag (Enumerate a)    } deriving Typeable      parts :: Enumerate a -> [Finite a]@@ -100,32 +101,34 @@   Enumerate (xs1 `prod` xs2) (fmap noOptim $ liftM2 cartesian o1 o2)  prod :: RevList (Finite a) -> RevList (Finite b) -> RevList (Finite (a,b))-prod (RevList [] _)          _                = mempty-prod (RevList xs0@(_:xst) _) (RevList _ rys0) = toRev$ prod' rys0 where+prod (RevList [] _)           _                 = mempty+prod (RevList xs0@(_:xst) _)  (RevList _ rys0)  = toRev$ prod' rys0 where    -- We need to thread carefully here, making sure that guarded recursion is safe   prod' []        = []   prod' (ry:rys)  = go ry rys where-    go ry    rys  = merge xs0 ry : case rys of-      (ry':rys') -> go ry' rys'-      []         -> prod'' ry xst+    go ry rys = conv xs0 ry : case rys of+      (ry':rys')   -> go ry' rys'+      []           -> prod'' ry xst    -- rys0 is exhausted, slide a window over xs0 until it is exhausted   prod'' :: [Finite b] -> [Finite a] -> [Finite (a,b)]   prod'' ry = go where     go []         = []-    go xs@(_:xs') = merge xs ry : go xs'+    go xs@(_:xs') = conv xs ry : go xs' -  merge :: [Finite a] -> [Finite b] -> Finite (a,b)-  merge xs ys = Finite +  conv :: [Finite a] -> [Finite b] -> Finite (a,b)+  conv xs ys = Finite      (sum $ zipWith (*) (map fCard xs) (map fCard ys ))      (prodSel xs ys)    prodSel :: [Finite a] -> [Finite b] -> (Index -> (a,b))-  prodSel (f1:f1s) (f2:f2s) = \i -> let mul = fCard f1 * fCard f2  in if i < mul -    then let (q, r) = (i `quotRem` fCard f2) -       in (fIndex f1 q, fIndex f2 r)-    else prodSel f1s f2s (i-mul)+  prodSel (f1:f1s) (f2:f2s) = \i -> +    let mul = fCard f1 * fCard f2  +    in  if i < mul +        then  let (q, r) = (i `quotRem` fCard f2) +              in (fIndex f1 q, fIndex f2 r)+        else prodSel f1s f2s (i-mul)   prodSel _ _ = \i -> error "index out of bounds"  @@ -157,7 +160,7 @@ data RevList a = RevList {fromRev :: [a], reversals :: [[a]]} deriving Show  instance Functor RevList where-  fmap f = toRev. fmap f . fromRev+  fmap f = toRev . fmap f . fromRev  -- Maybe this should be append instead? -- | Padded zip@@ -168,9 +171,9 @@     zipMon (x:xs) (y:ys) = x <> y : zipMon xs ys     zipMon xs ys         = xs ++ ys   --- | Constructs a reversable variant of a given list. In a sensible +-- | Constructs a "Reverse list" variant of a given list. In a sensible  -- Haskell implementation evaluating any inital segment of --- @reversals (toRevxs)@ uses linear memory in the size of the segment.+-- @'reversals' (toRev xs)@ uses linear memory in the size of the segment. toRev:: [a] -> RevList a toRev xs = RevList xs $ go [] xs where   go _ []       = []@@ -208,6 +211,13 @@ noOptim :: Enumerate a -> Enumerate a noOptim e = e{optimiser = return e} +-- | Used to avoid non-termination of 'optimise' in the presence of +-- irregular data types. @irregular@ should be applied to the enumeration for the +-- constructor that introduces the irregularity. Excessive use may impact +-- performance+irregular :: Enumerate a -> Enumerate a+irregular e = e{optimiser = gets $ evalState $ optimiser e}+           -------------------------------------------------------- -- Operations on finite sets@@ -227,6 +237,11 @@  instance Functor Finite where   fmap f fin = fin{fIndex = f . fIndex fin}++instance Applicative Finite where+  pure = finPure+  a <*> b = fmap (uncurry ($)) (finCart a b)+    instance Monoid (Finite a) where    mempty = finEmpty
Test/Feat/Modifiers.hs view
@@ -10,7 +10,7 @@ --  data C a = C [a] [a] deriving 'Typeable' --  instance 'Enumerable' a => 'Enumerable' (C a) where --     'enumerate' = 'unary' $ 'funcurry' $ ---       \xs ys -> C ('nonEmpty' xs) ('nonEmpty' ys)+--       \\xs ys -> C ('nonEmpty' xs) ('nonEmpty' ys) -- @ -- -- Alternatively you can put everything in pattern postition:@@ -18,11 +18,11 @@ -- @ --  instance 'Enumerable' a => 'Enumerable' (C a) where --     'enumerate' = 'unary' $ 'funcurry' $ ---       \('Free' ('NonEmpty' xs,'NonEmpty' ys)) -> C xs ys)+--       \\('Free' ('NonEmpty' xs,'NonEmpty' ys)) -> C xs ys) -- @ -- -- The first approach has the advantage of being usable with a --- point free style: @ \xs -> C ('nonEmpty' xs) . 'nonEmpty' @.+-- point free style: @ \\xs -> C ('nonEmpty' xs) . 'nonEmpty' @. module Test.Feat.Modifiers(   -- ** List modifiers   NonEmpty(..),
examples/lambda-terms/lambdas.hs view
@@ -1,37 +1,37 @@ -- This module contains an enumeration of well scoped lambda terms+{-# LANGUAGE DeriveDataTypeable #-} -{-#LANGUAGE DeriveDataTypeable#-}-import Test.Feat import Test.Feat.Enumerate+import Test.Feat.Class import Test.Feat.Access-import Data.MemoCombinators(bits) -- From package data-memocombinators----- De Bruijn style lambda calculus-data Lam = Lam Lam-         | App Lam Lam-         | Var Integer-         deriving (Show,Eq,Ord, Typeable)---enumLamPair :: Integer -> Enumerate (Lam,Lam)-enumLamPair = bits enumLamPair' where-  enumLamPair' n = (,) <$> enumLam n <*> enumLam n+import Test.Feat -enumLam :: Integer -> Enumerate Lam-enumLam = bits enumLam' where-  enumLam' n = -    let e = consts $-         [ App <$> e <*> e-         , fmap Lam $ enumLam (n+1)-         , fromParts [Finite n Var]-         ] -    in e +data Term scope  = Lam (Term (FinS scope))+                 | App (Term scope) (Term scope)+                 | Var scope +                 deriving (Show, Typeable)+instance Enumerable a => Enumerable (Term a) where+  enumerate  =   unary Var   -- Variables are size 0, add pay to make size 1+             <>  irregular (pay (unary Lam)) -- "Irregular constructor"+             <>  pay (unary (funcurry App)) -instance Enumerable Lam where-  enumerate = noOptim $ enumLam 0+-- Finite numeric types+data FinZ deriving Typeable+instance Show FinZ where+  show _ = undefined+instance Enumerable FinZ  where+  enumerate = mempty+data FinS n = Z | S n deriving (Typeable, Show)+instance Enumerable n => Enumerable (FinS n) where+  enumerate = pure Z <> fmap S shared +-- All closed lambda expressions+closed = optimal :: Enumerate (Term FinZ)+vs = valuesWith closed +-- Count the number of terms of a given size+count n = fst $ vs !! n -test n = take n $ values :: [(Integer,[Lam])]+-- Select any term of a given size+selectTerm = selectWith closed
examples/template-haskell/th.hs view
@@ -32,6 +32,8 @@ import Test.SmallCheck.Series hiding (Nat) import Test.SmallCheck +{-+ -- Currently both of these spit out a lot of errors unless we disable a few of the -- buggier constructors (which we have done below). test_parsesAll = ioAll 15 report_parses@@ -86,6 +88,7 @@     ]}  +-}     -- We define both SmallCheck and Feat enumerators for comparison.  @@ -448,7 +451,7 @@   coseries = undefined  -main = test_parsesBounded+-- main = test_parsesBounded -- or test_parsesAll, but that takes much longer to find bugs  eExp :: Enumerate Exp
testing-feat.cabal view
@@ -1,5 +1,5 @@ Name:                testing-feat-Version:             0.3.0.1+Version:             0.4 Synopsis:            Functional Enumeration of Abstract Types Description:         Feat (Functional Enumeration of Abstract Types) provides                      enumerations as functions from natural numbers to values @@ -13,7 +13,7 @@                      "Test.Feat" contain a subset of the other modules that                       should be sufficient for most test usage. There                       are some small and large example in the tar -                     ball.+                     ball. Builds with haskell-platform-2012-2.0.0 and with ghc-7.6.1.                                            License:             BSD3 License-file:        LICENSE