size-based 0.1.0.0 → 0.1.1.0
raw patch · 6 files changed
+464/−476 lines, 6 filesdep +semigroupsdep ~basedep ~template-haskellPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: semigroups
Dependency ranges changed: base, template-haskell
API changes (from Hackage documentation)
+ Control.Enumerable.Count: infixl 4 </>
+ Control.Enumerable.Count: instance Data.Semigroup.Semigroup (Control.Enumerable.Count.Count a)
- Control.Enumerable: class Typeable (a :: k)
+ Control.Enumerable: class Typeable k (a :: k)
- Control.Sized: class Alternative f => Sized f where pair a b = (,) <$> a <*> b aconcat [] = empty aconcat xs = foldr1 (<|>) xs fin n = aconcat (map pure [0 .. n - 1]) finSized = stdFinBits naturals = stdNaturals
+ Control.Sized: class Alternative f => Sized f
Files
- Control/Enumerable.hs +304/−307
- Control/Enumerable/Count.hs +28/−29
- Control/Enumerable/Derive.hs +3/−3
- Control/Enumerable/Values.hs +75/−79
- Control/Sized.hs +18/−19
- size-based.cabal +36/−39
Control/Enumerable.hs view
@@ -1,307 +1,304 @@-{-#LANGUAGE TemplateHaskell#-} - -{-| -This module provides the 'Enumerable' class, which has a simple purpose: Provide any enumeration for any instance type. The prerequisite is that the enumeration data type is a sized functor (see "Control.Sized") with the enumerated type as the type parameter. The general idea is that the size of a value is the number of constructor applications it contains. - -Because Sized functors often rely of memoization, sharing is important. Since class dictionaries are not always shared, a mechanism is added that guarantees optimal sharing (it never creates two separate instance members for the same type). This is why the type of 'enumerate' is @Shared f a@ instead of simply @f a@. The technicalities of this memoization are not important, but it means there are two modes for accessing an enumeration: 'local' and 'global'. The former means sharing is guaranteed within this value, but subsequent calls to local may recreate dictionaries. The latter guarantees optimal sharing even between calls. It also means the enumeration will never be garbage collected, so use with care in programs that run for extended periods of time and contains many (especially non-regular) types. - -Once a type has an instance, it can be enumerated in several ways (by instantiating 'global' to different types). For instance @global :: Count [Maybe Bool]@ would only count the number of lists of Maybe Bool of each size (using "Control.Enumerable.Count"). @global :: Values [Maybe Bool] would give the actual values for all sizes as lists. See <https://hackage.haskell.org/package/testing-feat FEAT> for a more elaborate enumeration type that allows access to any value in the enumeration (given an index) in polynomial time, uniform selection from a given size etc. - -Instances can be constructed in three ways: - -1: Manually by passing 'datatype' a list where each element is an application of the constructor functions 'c0', 'c1' etc, so a data type like Maybe would have @enumerate = datatype [c0 Nothing, c1 Just]@. This assumes all field types of all constructors are enumerable (recursive constructors work fine). The functions passed to @cX@ do not have to be constructors, but should be injective functions (if they are not injective the enumeration will contain duplicates). So "smart constructors" can be used, for instance the @Rational@ datatype is defined by an injection from the natural numbers. - -2: Automatically with Template Haskell ('deriveEnumerable'). A top level declaration like @deriveEnumerable ''Maybe@ would derive an instance for the @Maybe@ data type. - -3: Manually using the operations of a sized functor (see "Control.Sized") to build a @Shareable f a@ value, then apply 'share' to it. To use other instances of 'Enumerable' use 'access'. - --} -module Control.Enumerable - ( Enumerable(..) - -- * Class based construction - , datatype, c0, c1, c2, c3, c4, c5, c6, c7 - -- * Access - , global, local - - -- * Automatic derivation - , deriveEnumerable - , dAll, dExcluding, dExcept, ConstructorDeriv, deriveEnumerable' - - -- * Non-class construction - , access, share, Shared, Shareable, Typeable, module Control.Sized - - -- * Enumerating functions - , function, CoEnumerable(..) - - -- * Other stuff (required for instances) - , Infinite - )where -import Control.Sized -import Data.ClassSharing - --- For instances -import Data.Modifiers -import Data.Bits -import Data.Word -import Data.Int -import Data.Ratio -import Control.Enumerable.Derive hiding (global) - -instance (Typeable f, Sized f) => Sized (Shareable f) where - pay = Shareable . fmap pay . run - fin = Shareable . const . fin - pair x y = Shareable $ \r -> pair (run x r) (run y r) - -class Typeable a => Enumerable a where - enumerate :: (Typeable f, Sized f) => Shared f a - - --- | Used instead of enumerate when manually building instances. -access :: (Enumerable a, Sized f, Typeable f) => Shareable f a -access = unsafeAccess enumerate - --- | Guarantees local sharing. All enumerations are shared inside each invokation of local, but may not be shared between them. -{-#INLINE local#-} -local :: (Typeable f, Sized f, Enumerable a) => f a -local = run access (unsafeNewRef ()) - -{-#NOINLINE gref#-} -gref :: Ref -gref = unsafeNewRef () - --- | This is the primary way to access enumerations for usage. Guarantees global sharing of enumerations of the same type. Note that this means the enumerations are never garbage collected. -global :: (Typeable f, Sized f, Enumerable a) => f a -global = run access gref - --- | Builds an enumeration of a data type from a list of constructors (see c0-c7) -datatype :: (Typeable a, Sized f, Typeable f) => [Shareable f a] -> Shared f a -datatype = share . pay . aconcat - - --- | Takes a constructor with arity 0 (a pure value) -c0 :: Sized f => a -> Shareable f a -c0 = pure - --- | Takes a constructor of arity 1 -c1 :: (Enumerable a, Sized f, Typeable f) => (a -> x) -> Shareable f x -c1 f = fmap f access - -c2 :: (Enumerable a, Enumerable b, Sized f, Typeable f) => (a -> b -> x) -> Shareable f x -c2 f = c1 (uncurry f) - -c3 :: (Enumerable a, Enumerable b, Enumerable c, Sized f, Typeable f) => (a -> b -> c -> x) -> Shareable f x -c3 f = c2 (uncurry f) - -c4 :: (Enumerable a, Enumerable b, Enumerable c, Enumerable d, Sized f, Typeable f) => (a -> b -> c -> d -> x) -> Shareable f x -c4 f = c3 (uncurry f) - -c5 :: (Enumerable a, Enumerable b, Enumerable c, Enumerable d, Enumerable e, Sized f, Typeable f) => (a -> b -> c -> d -> e -> x) -> Shareable f x -c5 f = c4 (uncurry f) - -c6 :: (Enumerable a, Enumerable b, Enumerable c, Enumerable d, Enumerable e, Enumerable g, Sized f, Typeable f) => (a -> b -> c -> d -> e -> g -> x) -> Shareable f x -c6 f = c5 (uncurry f) - -c7 :: (Enumerable a, Enumerable b, Enumerable c, Enumerable d, Enumerable e, Enumerable g, Enumerable h, Sized f, Typeable f) => (a -> b -> c -> d -> e -> g -> h -> x) -> Shareable f x -c7 f = c6 (uncurry f) - --- More than seven constructor components? Uncurry your constructor! - - --- | The unit constructor is free -instance Enumerable () where - enumerate = share (pure ()) - --- All tuple constructors are free -instance (Enumerable a, Enumerable b) => Enumerable (a,b) where - enumerate = share $ pair access access -- Pairs are free - -instance (Enumerable a, Enumerable b, Enumerable c) => Enumerable (a,b,c) where - enumerate = share $ c1 $ \(a,(b,c)) -> (a,b,c) - -instance (Enumerable a, Enumerable b, Enumerable c, Enumerable d) - => Enumerable (a,b,c,d) where - enumerate = share $ c1 $ \(a,(b,(c,d))) -> (a,b,c,d) - -instance (Enumerable a, Enumerable b, Enumerable c, Enumerable d, Enumerable e) - => Enumerable (a,b,c,d,e) where - enumerate = share $ c1 $ \(a,(b,(c,(d,e)))) -> (a,b,c,d,e) - - -instance Enumerable Bool where - enumerate = datatype [pure False, pure True] - -instance (Enumerable a, Enumerable b) => Enumerable (Either a b) where - enumerate = datatype [c1 Left, c1 Right] - -instance Enumerable a => Enumerable [a] where - enumerate = datatype [pure [], c2 (:)] - -instance Enumerable a => Enumerable (Maybe a) where - enumerate = datatype [pure Nothing, c1 Just] - -instance Enumerable Ordering where - enumerate = datatype [pure LT, pure EQ, pure GT] - -instance Enumerable Integer where - enumerate = share $ c1 nat <|> c1 (\(Nat n) -> -n-1) - -instance Enumerable Word where enumerate = share word - -instance Enumerable Word8 where enumerate = share word -- enumerate = share (fromInteger <$> fin 256) -- Flat definition - -instance Enumerable Word16 where enumerate = share word - -instance Enumerable Word32 where enumerate = share word - -instance Enumerable Word64 where enumerate = share word - -instance Enumerable Int where enumerate = share int - -instance Enumerable Int8 where enumerate = share int - -instance Enumerable Int16 where enumerate = share int - -instance Enumerable Int32 where enumerate = share int - -instance Enumerable Int64 where enumerate = share int - --- | ASCII characters -instance Enumerable Char where - enumerate = share $ (toEnum . fromIntegral) <$> kbits 7 - -- Swap the printable characters to the start of the enumeration - -- swapCharacters :: Word8 -> Char - --- | Not a proper injection -instance Enumerable Float where - enumerate = share $ c2 $ \b a -> encodeFloat a (fromIntegral (b :: Int8)) - --- | Not a proper injection -instance Enumerable Double where - enumerate = share $ encodeFloat <$> access <*> e where - e = negate <$> enumerateBounded (-1) (-lo) <|> enumerateBounded 0 hi - (lo,hi) = floatRange (0 :: Double) - - --- | A class of infinite precision integral types. 'Integer' is the principal --- class member. -class (Typeable a, Integral a) => Infinite a -instance Infinite Integer - - -instance Infinite a => Enumerable (Ratio a) where - enumerate = share (c1 $ rat . nat) - --- | Bijection into the rationals -rat :: Integral a => Integer -> Ratio a -rat i | i < 0 = error "Index out of bounds" -rat i = go 1 1 i where - go a b 0 = a % b - go a b i = let (i',m) = i `divMod` 2 in if m == 1 then go (a+b) b i' else go a (a +b) i' - - --- From Data.Modifiers: -instance Enumerable Unicode where - enumerate = datatype [fmap Unicode $ enumerateBounded - (fromEnum (minBound :: Char)) - (fromEnum (maxBound :: Char))] - -instance Enumerable Printable where - enumerate = share $ fmap Printable $ enumerateBounded 32 126 - -enumerateBounded :: (Sized f, Enum a) => Int -> Int -> f a -enumerateBounded lo hi = trans <$> finSized (toInteger (hi - lo)) where - trans i = toEnum $ fromInteger (toInteger lo + i) - - - --- * modifiers: --- Enumerable Printable --- Enumerable Unicode --- (Infinite a, Enumerable a) => Enumerable (NonZero a) --- Infinite a => Enumerable (Nat a) --- Enumerable a => Enumerable (NonEmpty a) - -instance Infinite integer => Enumerable (Nat integer) where - enumerate = share (Nat . fromInteger <$> naturals) - -instance Enumerable a => Enumerable (NonEmpty a) where - enumerate = datatype [c2 $ mkNonEmpty] - - -word :: (FiniteBits a, Integral a, Sized f) => f a -word = let e = fromInteger <$> kbits (bitSize' e) in e - -int :: (FiniteBits a, Integral a, Sized f) => f a -int = let e = fromInteger <$> kbs <|> (\n -> fromInteger (-n-1)) <$> kbs - kbs = finSized (2^(bitSize' e - 1)) - in e - - -bitSize' :: FiniteBits a => f a -> Int -bitSize' f = hlp (error "Enumerable: This is not supposed to be inspected") f where - hlp :: FiniteBits a => a -> f a -> Int - hlp a _ = finiteBitSize a - - --- | Work in progress -class Typeable a => CoEnumerable a where - coEnumerate :: (Enumerable b,Sized f, Typeable f) => Shared f (a -> b) - --- | Builds a suitable definition for @coEnumerate@ given an pattern matching function for a data type (see source for examples). -function :: (Typeable a, Enumerable b, Sized f, Typeable f) => Shareable f (a -> b) -> Shared f (a -> b) -function f = datatype [ c1 const, f] - - -instance (CoEnumerable a, Enumerable b) => Enumerable (a -> b) where - enumerate = coEnumerate - -instance CoEnumerable Bool where - coEnumerate = function $ c2 $ \x y b -> if b then x else y - -instance CoEnumerable a => CoEnumerable [a] where - coEnumerate = function $ c2 $ - \uf cf xs -> case xs of - [] -> uf - (x:xs) -> cf x xs - - - - - - -deriveEnumerable :: Name -> Q [Dec] -deriveEnumerable = deriveEnumerable' . dAll - - -type ConstructorDeriv = (Name, [(Name, ExpQ)]) -dAll :: Name -> ConstructorDeriv -dAll n = (n,[]) -dExcluding :: Name -> ConstructorDeriv -> ConstructorDeriv -dExcluding n (t,nrs) = (t,(n,[|empty|]):nrs) -dExcept :: Name -> ExpQ -> ConstructorDeriv -> ConstructorDeriv -dExcept n e (t,nrs) = (t,(n,e):nrs) - --- | Derive an instance of Enumberable with Template Haskell, with --- rules for some specific constructors -deriveEnumerable' :: ConstructorDeriv -> Q [Dec] -deriveEnumerable' (n,cse) = - fmap return $ instanceFor ''Enumerable [enumDef] n - where - enumDef :: [(Name,[Type])] -> Q Dec - enumDef cons = do - sanityCheck - fmap mk_freqs_binding [|datatype $ex |] - where - ex = listE $ map cone cons - cone xs@(n,_) = maybe (cone' xs) id $ lookup n cse - cone' (n,[]) = [|c0 $(conE n)|] - cone' (n,_:vs) = - [|c1 $(foldr appE (conE n) (map (const [|uncurry|] ) vs) )|] - mk_freqs_binding :: Exp -> Dec - mk_freqs_binding e = ValD (VarP 'enumerate ) (NormalB e) [] - sanityCheck = case filter (`notElem` map fst cons) (map fst cse) of - [] -> return () - xs -> error $ "Invalid constructors for "++show n++": "++show xs - - - +{-#LANGUAGE TemplateHaskell#-}++{-|+This module provides the 'Enumerable' class, which has a simple purpose: Provide any enumeration for any instance type. The prerequisite is that the enumeration data type is a sized functor (see "Control.Sized") with the enumerated type as the type parameter. The general idea is that the size of a value is the number of constructor applications it contains.++Because Sized functors often rely of memoization, sharing is important. Since class dictionaries are not always shared, a mechanism is added that guarantees optimal sharing (it never creates two separate instance members for the same type). This is why the type of 'enumerate' is @Shared f a@ instead of simply @f a@. The technicalities of this memoization are not important, but it means there are two modes for accessing an enumeration: 'local' and 'global'. The former means sharing is guaranteed within this value, but subsequent calls to local may recreate dictionaries. The latter guarantees optimal sharing even between calls. It also means the enumeration will never be garbage collected, so use with care in programs that run for extended periods of time and contains many (especially non-regular) types.++Once a type has an instance, it can be enumerated in several ways (by instantiating 'global' to different types). For instance @global :: Count [Maybe Bool]@ would only count the number of lists of Maybe Bool of each size (using "Control.Enumerable.Count"). @global :: Values [Maybe Bool] would give the actual values for all sizes as lists. See <https://hackage.haskell.org/package/testing-feat FEAT> for a more elaborate enumeration type that allows access to any value in the enumeration (given an index) in polynomial time, uniform selection from a given size etc.++Instances can be constructed in three ways:++1: Manually by passing 'datatype' a list where each element is an application of the constructor functions 'c0', 'c1' etc, so a data type like Maybe would have @enumerate = datatype [c0 Nothing, c1 Just]@. This assumes all field types of all constructors are enumerable (recursive constructors work fine). The functions passed to @cX@ do not have to be constructors, but should be injective functions (if they are not injective the enumeration will contain duplicates). So "smart constructors" can be used, for instance the @Rational@ datatype is defined by an injection from the natural numbers.++2: Automatically with Template Haskell ('deriveEnumerable'). A top level declaration like @deriveEnumerable ''Maybe@ would derive an instance for the @Maybe@ data type.++3: Manually using the operations of a sized functor (see "Control.Sized") to build a @Shareable f a@ value, then apply 'share' to it. To use other instances of 'Enumerable' use 'access'.++-}+module Control.Enumerable+ ( Enumerable(..)+ -- * Class based construction+ , datatype, c0, c1, c2, c3, c4, c5, c6, c7+ -- * Access+ , global, local++ -- * Automatic derivation+ , deriveEnumerable+ , dAll, dExcluding, dExcept, ConstructorDeriv, deriveEnumerable'++ -- * Non-class construction+ , access, share, Shared, Shareable, Typeable, module Control.Sized++ -- * Enumerating functions+ , function, CoEnumerable(..)++ -- * Other stuff (required for instances)+ , Infinite+ )where+import Control.Sized+import Data.ClassSharing++-- For instances+import Data.Modifiers+import Data.Bits+import Data.Word+import Data.Int+import Data.Ratio+import Control.Enumerable.Derive hiding (global)++instance (Typeable f, Sized f) => Sized (Shareable f) where+ pay = Shareable . fmap pay . run+ fin = Shareable . const . fin+ pair x y = Shareable $ \r -> pair (run x r) (run y r)++class Typeable a => Enumerable a where+ enumerate :: (Typeable f, Sized f) => Shared f a+++-- | Used instead of enumerate when manually building instances.+access :: (Enumerable a, Sized f, Typeable f) => Shareable f a+access = unsafeAccess enumerate++-- | Guarantees local sharing. All enumerations are shared inside each invokation of local, but may not be shared between them.+{-#INLINE local#-}+local :: (Typeable f, Sized f, Enumerable a) => f a+local = run access (unsafeNewRef ())++{-#NOINLINE gref#-}+gref :: Ref+gref = unsafeNewRef ()++-- | This is the primary way to access enumerations for usage. Guarantees global sharing of enumerations of the same type. Note that this means the enumerations are never garbage collected.+global :: (Typeable f, Sized f, Enumerable a) => f a+global = run access gref++-- | Builds an enumeration of a data type from a list of constructors (see c0-c7)+datatype :: (Typeable a, Sized f, Typeable f) => [Shareable f a] -> Shared f a+datatype = share . pay . aconcat+++-- | Takes a constructor with arity 0 (a pure value)+c0 :: Sized f => a -> Shareable f a+c0 = pure++-- | Takes a constructor of arity 1+c1 :: (Enumerable a, Sized f, Typeable f) => (a -> x) -> Shareable f x+c1 f = fmap f access++c2 :: (Enumerable a, Enumerable b, Sized f, Typeable f) => (a -> b -> x) -> Shareable f x+c2 f = c1 (uncurry f)++c3 :: (Enumerable a, Enumerable b, Enumerable c, Sized f, Typeable f) => (a -> b -> c -> x) -> Shareable f x+c3 f = c2 (uncurry f)++c4 :: (Enumerable a, Enumerable b, Enumerable c, Enumerable d, Sized f, Typeable f) => (a -> b -> c -> d -> x) -> Shareable f x+c4 f = c3 (uncurry f)++c5 :: (Enumerable a, Enumerable b, Enumerable c, Enumerable d, Enumerable e, Sized f, Typeable f) => (a -> b -> c -> d -> e -> x) -> Shareable f x+c5 f = c4 (uncurry f)++c6 :: (Enumerable a, Enumerable b, Enumerable c, Enumerable d, Enumerable e, Enumerable g, Sized f, Typeable f) => (a -> b -> c -> d -> e -> g -> x) -> Shareable f x+c6 f = c5 (uncurry f)++c7 :: (Enumerable a, Enumerable b, Enumerable c, Enumerable d, Enumerable e, Enumerable g, Enumerable h, Sized f, Typeable f) => (a -> b -> c -> d -> e -> g -> h -> x) -> Shareable f x+c7 f = c6 (uncurry f)++-- More than seven constructor components? Uncurry your constructor!+++-- | The unit constructor is free+instance Enumerable () where+ enumerate = share (pure ())++-- All tuple constructors are free+instance (Enumerable a, Enumerable b) => Enumerable (a,b) where+ enumerate = share $ pair access access -- Pairs are free++instance (Enumerable a, Enumerable b, Enumerable c) => Enumerable (a,b,c) where+ enumerate = share $ c1 $ \(a,(b,c)) -> (a,b,c)++instance (Enumerable a, Enumerable b, Enumerable c, Enumerable d)+ => Enumerable (a,b,c,d) where+ enumerate = share $ c1 $ \(a,(b,(c,d))) -> (a,b,c,d)++instance (Enumerable a, Enumerable b, Enumerable c, Enumerable d, Enumerable e)+ => Enumerable (a,b,c,d,e) where+ enumerate = share $ c1 $ \(a,(b,(c,(d,e)))) -> (a,b,c,d,e)+++instance Enumerable Bool where+ enumerate = datatype [pure False, pure True]++instance (Enumerable a, Enumerable b) => Enumerable (Either a b) where+ enumerate = datatype [c1 Left, c1 Right]++instance Enumerable a => Enumerable [a] where+ enumerate = datatype [pure [], c2 (:)]++instance Enumerable a => Enumerable (Maybe a) where+ enumerate = datatype [pure Nothing, c1 Just]++instance Enumerable Ordering where+ enumerate = datatype [pure LT, pure EQ, pure GT]++instance Enumerable Integer where+ enumerate = share $ c1 nat <|> c1 (\(Nat n) -> -n-1)++instance Enumerable Word where enumerate = share word++instance Enumerable Word8 where enumerate = share word -- enumerate = share (fromInteger <$> fin 256) -- Flat definition++instance Enumerable Word16 where enumerate = share word++instance Enumerable Word32 where enumerate = share word++instance Enumerable Word64 where enumerate = share word++instance Enumerable Int where enumerate = share int++instance Enumerable Int8 where enumerate = share int++instance Enumerable Int16 where enumerate = share int++instance Enumerable Int32 where enumerate = share int++instance Enumerable Int64 where enumerate = share int++-- | ASCII characters+instance Enumerable Char where+ enumerate = share $ (toEnum . fromIntegral) <$> kbits 7+ -- Swap the printable characters to the start of the enumeration+ -- swapCharacters :: Word8 -> Char++-- | Not a proper injection+instance Enumerable Float where+ enumerate = share $ c2 $ \b a -> encodeFloat a (fromIntegral (b :: Int8))++-- | Not a proper injection+instance Enumerable Double where+ enumerate = share $ encodeFloat <$> access <*> e where+ e = negate <$> enumerateBounded (-1) (-lo) <|> enumerateBounded 0 hi+ (lo,hi) = floatRange (0 :: Double)+++-- | A class of infinite precision integral types. 'Integer' is the principal+-- class member.+class (Typeable a, Integral a) => Infinite a+instance Infinite Integer+++instance Infinite a => Enumerable (Ratio a) where+ enumerate = share (c1 $ rat . nat)++-- | Bijection into the rationals+rat :: Integral a => Integer -> Ratio a+rat i | i < 0 = error "Index out of bounds"+rat i = go 1 1 i where+ go a b 0 = a % b+ go a b i = let (i',m) = i `divMod` 2 in if m == 1 then go (a+b) b i' else go a (a +b) i'+++-- From Data.Modifiers:+instance Enumerable Unicode where+ enumerate = datatype [fmap Unicode $ enumerateBounded+ (fromEnum (minBound :: Char))+ (fromEnum (maxBound :: Char))]++instance Enumerable Printable where+ enumerate = share $ fmap Printable $ enumerateBounded 32 126++enumerateBounded :: (Sized f, Enum a) => Int -> Int -> f a+enumerateBounded lo hi = trans <$> finSized (toInteger (hi - lo)) where+ trans i = toEnum $ fromInteger (toInteger lo + i)++++-- * modifiers:+-- Enumerable Printable+-- Enumerable Unicode+-- (Infinite a, Enumerable a) => Enumerable (NonZero a)+-- Infinite a => Enumerable (Nat a)+-- Enumerable a => Enumerable (NonEmpty a)++instance Infinite integer => Enumerable (Nat integer) where+ enumerate = share (Nat . fromInteger <$> naturals)++instance Enumerable a => Enumerable (NonEmpty a) where+ enumerate = datatype [c2 $ mkNonEmpty]+++word :: (FiniteBits a, Integral a, Sized f) => f a+word = let e = fromInteger <$> kbits (bitSize' e) in e++int :: (FiniteBits a, Integral a, Sized f) => f a+int = let e = fromInteger <$> kbs <|> (\n -> fromInteger (-n-1)) <$> kbs+ kbs = finSized (2^(bitSize' e - 1))+ in e+++bitSize' :: FiniteBits a => f a -> Int+bitSize' f = hlp (error "Enumerable: This is not supposed to be inspected") f where+ hlp :: FiniteBits a => a -> f a -> Int+ hlp a _ = finiteBitSize a+++-- | Work in progress+class Typeable a => CoEnumerable a where+ coEnumerate :: (Enumerable b,Sized f, Typeable f) => Shared f (a -> b)++-- | Builds a suitable definition for @coEnumerate@ given an pattern matching function for a data type (see source for examples).+function :: (Typeable a, Enumerable b, Sized f, Typeable f) => Shareable f (a -> b) -> Shared f (a -> b)+function f = datatype [ c1 const, f]+++instance (CoEnumerable a, Enumerable b) => Enumerable (a -> b) where+ enumerate = coEnumerate++instance CoEnumerable Bool where+ coEnumerate = function $ c2 $ \x y b -> if b then x else y++instance CoEnumerable a => CoEnumerable [a] where+ coEnumerate = function $ c2 $+ \uf cf xs -> case xs of+ [] -> uf+ (x:xs) -> cf x xs+++++++deriveEnumerable :: Name -> Q [Dec]+deriveEnumerable = deriveEnumerable' . dAll+++type ConstructorDeriv = (Name, [(Name, ExpQ)])+dAll :: Name -> ConstructorDeriv+dAll n = (n,[])+dExcluding :: Name -> ConstructorDeriv -> ConstructorDeriv+dExcluding n (t,nrs) = (t,(n,[|empty|]):nrs)+dExcept :: Name -> ExpQ -> ConstructorDeriv -> ConstructorDeriv+dExcept n e (t,nrs) = (t,(n,e):nrs)++-- | Derive an instance of Enumberable with Template Haskell, with+-- rules for some specific constructors+deriveEnumerable' :: ConstructorDeriv -> Q [Dec]+deriveEnumerable' (n,cse) =+ fmap return $ instanceFor ''Enumerable [enumDef] n+ where+ enumDef :: [(Name,[Type])] -> Q Dec+ enumDef cons = do+ sanityCheck+ fmap mk_freqs_binding [|datatype $ex |]+ where+ ex = listE $ map cone cons+ cone xs@(n,_) = maybe (cone' xs) id $ lookup n cse+ cone' (n,[]) = [|c0 $(conE n)|]+ cone' (n,_:vs) =+ [|c1 $(foldr appE (conE n) (map (const [|uncurry|] ) vs) )|]+ mk_freqs_binding :: Exp -> Dec+ mk_freqs_binding e = ValD (VarP 'enumerate ) (NormalB e) []+ sanityCheck = case filter (`notElem` map fst cons) (map fst cse) of+ [] -> return ()+ xs -> error $ "Invalid constructors for "++show n++": "++show xs
Control/Enumerable/Count.hs view
@@ -1,7 +1,7 @@ {-#LANGUAGE DeriveDataTypeable#-} module Control.Enumerable.Count (- Count(..), + Count(..), (!!*), (</>), module Control.Enumerable@@ -9,6 +9,7 @@ import Control.Enumerable import Control.Sized+import Data.Semigroup import Data.Monoid(Monoid(..)) import Data.List import Data.Typeable(Typeable)@@ -27,7 +28,7 @@ compact :: Count a -> Count a compact = Count . reverse . dropWhile (==0) . reverse . count --- | Counts the number of values of a given size, 0 if out of bounds. +-- | Counts the number of values of a given size, 0 if out of bounds. (!!*) :: Count a -> Int -> Integer (Count []) !!* n = 0 (Count (x:xs)) !!* n | n < 0 = 0@@ -35,8 +36,8 @@ | otherwise = Count xs !!* (n-1) -- Undecidable for some 0-lists, for instance datatype with only infinite values--- instance Eq (Count a) where --- a == b = f a == f b +-- instance Eq (Count a) where+-- a == b = f a == f b -- where f = count . compact -- Typically infinite, perhaps it should have some hard-coded limit.@@ -47,7 +48,7 @@ instance Functor Count where fmap _ (Count xs) = Count xs -instance Applicative Count where +instance Applicative Count where pure _ = Count [1] (Count []) <*> (Count _) = empty@@ -58,20 +59,23 @@ mult = conv xs0 run [] = [] run (r:rs) = go r rs- go r rs = mult r : case rs of + go r rs = mult r : case rs of [] -> go' r xs0' (r':rs') -> go r' rs' go' r [] = [] go' r xs@(_:xs') = conv r xs : go' r xs' -instance Alternative Count where +instance Alternative Count where empty = Count [] ~(Count xs) <|> ~(Count ys) = Count $ zipWithL (+) xs ys where zipWithL f (x:xs) (y:ys) = f x y : zipWithL f xs ys zipWithL _ [] ys = ys zipWithL _ xs [] = xs -instance Monoid (Count a) where +instance Semigroup (Count a) where+ (<>) = (<|>)++instance Monoid (Count a) where mempty = empty mappend = (<|>) @@ -92,7 +96,7 @@ lim = i `div` 2 -} -infixl 3 <-> +infixl 3 <-> (Count xs) <-> (Count ys) = Count $ zipWithLL op xs ys where op n m = max 0 (n-m) zipWithLL f xs [] = xs@@ -112,7 +116,7 @@ revy = reverse ys0 go' [] _ = [] go' (x:xs) (ds') = ((x - (conv revy ds' )) `div` y) : go' xs (tail ds')- + -- Yap is the inverse of pay. yap :: Count a -> Count a yap (Count xs) = Count (drop 1 xs)@@ -120,7 +124,7 @@ reversals' :: [a] -> [[a]] reversals' = go [] where- go rs xs = rs : case xs of + go rs xs = rs : case xs of [] -> [] (x:xs) -> go (x:rs) xs @@ -130,13 +134,13 @@ -- Dissapointingly, this is the fastest version of conv I have discovered so far conv :: [Integer] -> [Integer] -> Integer-conv xs = sum . zipWith (*) xs +conv xs = sum . zipWith (*) xs {-#INLINE conv#-} conv' :: [Integer] -> [Integer] -> Integer conv' (_:xs) (0:ys) = conv' xs ys conv' (0:xs) (_:ys) = conv' xs ys-conv' xs ys = sum (zipWith (*) xs ys) +conv' xs ys = sum (zipWith (*) xs ys) {-#INLINE conv'#-} @@ -155,7 +159,7 @@ strictL :: [Integer] -> [Integer] strictL xs = foldr seq xs xs -cap :: Int -> Count a -> Count a +cap :: Int -> Count a -> Count a cap k c = strict (cardTake (k+1) c) -- Computes the k'th index in a product@@ -170,19 +174,19 @@ rev = reverse sub2 sub1 = drop (n+1-rl) (count cl1) - + prodsK, prodsK' :: [Count a] -> Int -> Count a prodsK [] _ = Count [1] prodsK [x] k = x -- No length guarantee prodsK xs k = cardRev $ prodsKR xs k--- Produces the reversed K-product of all given lists +-- Produces the reversed K-product of all given lists -- By removing all pays we get a much smaller actual k for the products. -- Intermediate lists need to be freed up for garbage collection. prodsKR :: [Count a] -> Int -> Count a --prodsKR [] k = Count [1]-prodsKR (Count x:xs) k = strict $ +prodsKR (Count x:xs) k = strict $ Count $ foldl' prodR (reverse $ take (k+1) (x ++ repeat 0)) xs where- + (xs', p) = baseCosts 0 [] xs @@ -194,10 +198,10 @@ prodsK' xs0 k = cap k $ go xs0 where go [] = Count [1] go [x] = x- go (x:xs) = untyped x <*> go xs - - --- prop_ProdsK k cls = prodsK smallK cls == + go (x:xs) = untyped x <*> go xs+++-- prop_ProdsK k cls = prodsK smallK cls == -- smallK = k `mod` 20 ultraDiv :: [Count ()] -> [Count ()] -> Int -> Count ()@@ -227,16 +231,11 @@ [] !!* n = 0 (x:xs) !!* 0 = x (x:xs) !!* n = xs !!* (n-1)- + prop_multCom a b = (untyped a <*> b) == (untyped b <*> a)- + prop_div :: Count (a -> a) -> Count a -> Property prop_div a b = any (/= 0) (count b) ==> ((a <*> b) </> b) == untyped a prop_div_id a = any (/= 0) (count a) ==> (a </> a) == pure () -}-----
Control/Enumerable/Derive.hs view
@@ -8,7 +8,7 @@ instanceFor clname confs dtname = do (cxt,dtvs,cons) <- extractData dtname cd <- mapM conData cons- let + let #if MIN_VERSION_template_haskell(2,10,0) mkCxt = fmap (cxt++) $ mapM (appT (conT clname) . varT) dtvs #else@@ -47,8 +47,8 @@ x :: IO Type-x = runQ $ (toType ''(,)) - +x = runQ $ (toType ''(,))+ toType n = case lookup n tups of Nothing -> conT n
Control/Enumerable/Values.hs view
@@ -1,79 +1,75 @@-{-#LANGUAGE DeriveDataTypeable#-} -module Control.Enumerable.Values - ( values - , values' - , allValues - , Values (..) - ) where - -import Control.Enumerable - --- | Constructs all values of a given size. -values :: Enumerable a => Int -> [a] -values = runValues global - --- | Constructs all values up to a given size. -values' :: Enumerable a => Int -> [[a]] -values' i = let f = runValues global in [f x|x <- [0..i]] - -allValues :: Enumerable a => [[a]] -allValues = aux global global where - aux :: Values a -> MaxSize a -> [[a]] - aux (Values f) (MaxSize m) = map f (zipWith const [0..] m) - - - -newtype Values a = Values {runValues :: Int -> [a]} deriving Typeable - -instance Functor Values where - fmap f = Values . fmap (fmap f) . runValues - -instance Applicative Values where - pure x = Values $ \i -> if i == 0 then [x] else [] - fs <*> xs = fmap (uncurry ($)) (pair fs xs) - -instance Alternative Values where - empty = Values $ \_ -> [] - xs <|> ys = Values $ \i -> runValues xs i ++ runValues ys i - -instance Sized Values where - pay xs = Values $ \i -> if i > 0 then runValues xs (i-1) else [] - pair xs ys = Values $ \i -> [(x,y)|n <- [0..i], x <- runValues xs n, y <- runValues ys (i-n)] - - fin n = Values $ \i -> if i == 0 then [0..n-1] else [] - aconcat [] = empty - aconcat [x] = x - aconcat xss = Values $ \i -> concatMap (($ i) . runValues) xss - - - - --- Useful for detecting if an enumeration is finite. -data MaxSize a = MaxSize {runMaxSize :: [()]} deriving Show -instance Functor MaxSize where fmap _ = MaxSize . runMaxSize - -instance Applicative MaxSize where - pure _ = MaxSize [()] - MaxSize [] <*> _ = empty - _ <*> MaxSize [] = empty - f <*> x = MaxSize $ tail (runMaxSize f ++ runMaxSize x) - -instance Alternative MaxSize where - empty = MaxSize [] - a <|> b = MaxSize (runMaxSize a `zipL` runMaxSize b) where - zipL [] x = x - zipL x [] = x - zipL (_:xs) (_:ys) = () : xs `zipL` ys - - -instance Sized MaxSize where - pay = MaxSize . (():) . runMaxSize - - -type TT = Bool -- [[[[[[[[[[Bool]]]]]]]]]] -tst1 n = take n $ runMaxSize (local :: MaxSize TT) - - - --- -- | All values are memoised. Warning: Using this may be faster but potentially uses a lot of memory. --- data Memoised a = Memoised {unMemoised :: [[a]]} +{-#LANGUAGE DeriveDataTypeable#-}+module Control.Enumerable.Values+ ( values+ , values'+ , allValues+ , Values (..)+ ) where++import Control.Enumerable++-- | Constructs all values of a given size.+values :: Enumerable a => Int -> [a]+values = runValues global++-- | Constructs all values up to a given size.+values' :: Enumerable a => Int -> [[a]]+values' i = let f = runValues global in [f x|x <- [0..i]]++allValues :: Enumerable a => [[a]]+allValues = aux global global where+ aux :: Values a -> MaxSize a -> [[a]]+ aux (Values f) (MaxSize m) = map f (zipWith const [0..] m)++++newtype Values a = Values {runValues :: Int -> [a]} deriving Typeable++instance Functor Values where+ fmap f = Values . fmap (fmap f) . runValues++instance Applicative Values where+ pure x = Values $ \i -> if i == 0 then [x] else []+ fs <*> xs = fmap (uncurry ($)) (pair fs xs)++instance Alternative Values where+ empty = Values $ \_ -> []+ xs <|> ys = Values $ \i -> runValues xs i ++ runValues ys i++instance Sized Values where+ pay xs = Values $ \i -> if i > 0 then runValues xs (i-1) else []+ pair xs ys = Values $ \i -> [(x,y)|n <- [0..i], x <- runValues xs n, y <- runValues ys (i-n)]++ fin n = Values $ \i -> if i == 0 then [0..n-1] else []+ aconcat [] = empty+ aconcat [x] = x+ aconcat xss = Values $ \i -> concatMap (($ i) . runValues) xss+++++-- Useful for detecting if an enumeration is finite.+data MaxSize a = MaxSize {runMaxSize :: [()]} deriving (Show, Typeable)+instance Functor MaxSize where fmap _ = MaxSize . runMaxSize++instance Applicative MaxSize where+ pure _ = MaxSize [()]+ MaxSize [] <*> _ = empty+ _ <*> MaxSize [] = empty+ f <*> x = MaxSize $ tail (runMaxSize f ++ runMaxSize x)++instance Alternative MaxSize where+ empty = MaxSize []+ a <|> b = MaxSize (runMaxSize a `zipL` runMaxSize b) where+ zipL [] x = x+ zipL x [] = x+ zipL (_:xs) (_:ys) = () : xs `zipL` ys+++instance Sized MaxSize where+ pay = MaxSize . (():) . runMaxSize+++type TT = Bool -- [[[[[[[[[[Bool]]]]]]]]]]+tst1 n = take n $ runMaxSize (local :: MaxSize TT)+
Control/Sized.hs view
@@ -1,26 +1,26 @@ -{-| +{-| -This module provides the 'Sized' class. Instances of this class are typically collection data types for infinite sets of values with a finite number of values of any given size. +This module provides the 'Sized' class. Instances of this class are typically collection data types for infinite sets of values with a finite number of values of any given size. -A simple example is "Control.Enumerable.Count" that just counts the number of values of each size. "Control.Enumerable.Values" provides all values of a given size. -<https://hackage.haskell.org/package/testing-feat FEAT> provides any value in the set much more efficiently. +A simple example is "Control.Enumerable.Count" that just counts the number of values of each size. "Control.Enumerable.Values" provides all values of a given size.+<https://hackage.haskell.org/package/testing-feat FEAT> provides any value in the set much more efficiently. -} module Control.Sized (module Control.Applicative, Sized(..), kbits) where import Control.Applicative --- | A sized functor is an applicative functor extended with a notion of cost/size of contained values. This is useful for any type of bounded recursion over infinite sets, most notably for various kind of enumerations. +-- | A sized functor is an applicative functor extended with a notion of cost/size of contained values. This is useful for any type of bounded recursion over infinite sets, most notably for various kind of enumerations. ----- The intention is that every sized functor definition models a (usually) infinite set (technically a bag) with a finite number of values of any given size. As long as every cyclic (recursive) definition has at least one application of pay, this invariant is guaranteed. +-- The intention is that every sized functor definition models a (usually) infinite set (technically a bag) with a finite number of values of any given size. As long as every cyclic (recursive) definition has at least one application of pay, this invariant is guaranteed. ----- The module "Control.Enumerable" provides sized functor definitions for a lot of data types, such that the size of a value is the number of constructor applications it contains. It also allows deriving these functors for any user defined data type (using Template Haskell). +-- The module "Control.Enumerable" provides sized functor definitions for a lot of data types, such that the size of a value is the number of constructor applications it contains. It also allows deriving these functors for any user defined data type (using Template Haskell). class Alternative f => Sized f where- -- | Increases the cost/size of all values in the given set. + -- | Increases the cost/size of all values in the given set. pay :: f a -> f a - -- | Default: @pair a b = (,) <$> a <*> b@. + -- | Default: @pair a b = (,) <$> a <*> b@. pair :: f a -> f b -> f (a,b) pair a b = (,) <$> a <*> b @@ -29,20 +29,20 @@ aconcat [] = empty aconcat xs = foldr1 (<|>) xs - {- | Finite numeric types. @fin n@ contains all non-negative numbers below n. This definition is flat, all integers have the same size. - Implementing this function efficiently will have a great impact on applications that use a lot of bounded numberic types (e.g. Int).- + {- | Finite numeric types. @fin n@ contains all non-negative numbers below n. This definition is flat, all integers have the same size.+ Implementing this function efficiently will have a great impact on applications that use a lot of bounded numeric types (e.g. Int).+ Default: aconcat (map pure [0..n-1]) -} fin :: Integer -> f Integer fin n = aconcat (map pure [0..n-1])- - {- |Same as 'fin' but the size of values may differ. - By default, the size of an integer is the number of significant bits in its binary representation. In other words, 0 has size zero, the values for size k>0 in @finBits n@ are in the interval ++ {- |Same as 'fin' but the size of values may differ.+ By default, the size of an integer is the number of significant bits in its binary representation. In other words, 0 has size zero, the values for size k>0 in @finBits n@ are in the interval @(2^(k-1),min (2^k-1) n)@. -} finSized :: Integer -> f Integer finSized = stdFinBits - -- | Non-negative integers. By default, the size of an integer is the number of digits in its binary representation. + -- | Non-negative integers. By default, the size of an integer is the number of digits in its binary representation. naturals :: f Integer naturals = stdNaturals @@ -64,7 +64,7 @@ go n = pay $ (n+) <$> fin (i-n) lim = i `div` 2 --- Non-negative integers of a given maximal number of bits. +-- Non-negative integers of a given maximal number of bits. kbits :: Sized f => Int -> f Integer kbits k = finSized (2^k) @@ -72,7 +72,6 @@ -- integers :: Sized f => (Int -> (Integer,Integer)) -> f Integer--- integers = +-- integers = -- ints :: Sized f => Int -> (Int -> (Integer,Integer)) -> f Integer-
size-based.cabal view
@@ -1,40 +1,37 @@--- Initial sized-functors.cabal generated by cabal init. For further --- documentation, see http://haskell.org/cabal/users-guide/ - -name: size-based -version: 0.1.0.0 -synopsis: Sized functors, for size-based enumerations -description: - -license: BSD3 -license-file: LICENSE -author: Jonas Duregård -maintainer: jonas.duregard@chalmers.se --- copyright: -category: Data -build-type: Simple --- extra-source-files: -cabal-version: >=1.10 - -source-repository head - type: git - location: https://github.com/JonasDuregard/sized-functors - -library - exposed-modules: - Control.Sized - Control.Enumerable - Control.Enumerable.Count - Control.Enumerable.Values --- Control.Enumerable.Functions --- Control.Enumerable.LazySearch - - other-modules: - Control.Enumerable.Derive - other-extensions: GADTs, DeriveDataTypeable - build-depends: base >=4.7 && <5, - dictionary-sharing >= 0.1 && < 1.0, - testing-type-modifiers >= 0.1 && < 1.0, - template-haskell >=2.5 && <2.12 - -- hs-source-dirs: +name: size-based+version: 0.1.1.0+synopsis: Sized functors, for size-based enumerations+description:++license: BSD3+license-file: LICENSE+author: Jonas Duregård+maintainer: jonas.duregard@chalmers.se+copyright: (c) Jonas Duregård+category: Data+build-type: Simple+cabal-version: >=1.10++source-repository head+ type: git+ location: https://github.com/JonasDuregard/sized-functors++library+ exposed-modules:+ Control.Sized+ Control.Enumerable+ Control.Enumerable.Count+ Control.Enumerable.Values+-- Control.Enumerable.Functions+-- Control.Enumerable.LazySearch++ other-modules:+ Control.Enumerable.Derive+ other-extensions: GADTs, DeriveDataTypeable+ build-depends: base >=4.7 && <5,+ dictionary-sharing >= 0.1 && < 1.0,+ testing-type-modifiers >= 0.1 && < 1.0,+ template-haskell >=2.5 && <2.14+ if impl(ghc < 8.0)+ build-depends: semigroups < 0.19 default-language: Haskell2010