Safe Haskell | None |
---|---|
Language | Haskell2010 |
Exports the POSable
class, which has a generic implementation GPOSable
.
Also re-exports Generic.SOP, which is needed to derive POSable.
Documentation
class KnownNat (Choices x) => POSable x where Source #
POSable, the base of this library. Provide a compact memory representation
for a type and a function to get back to the original type.
This memory representation consist of choices
, that represent all
constructor choices in the type in a single Finite integer, and fields
which represents all values in the type as a Product of Sums, which can
be mapped to a struct-of-arrays representation for use in array-based
languages like Accelerate.
Nothing
choices :: x -> Finite (Choices x) Source #
default choices :: (Generic x, GPOSable (SOP I (Code x)), GChoices (SOP I (Code x)) ~ Choices x) => x -> Finite (Choices x) Source #
The tags
function returns the range of each constructor.
A few examples:
>>> tags Bool
[1,1]
>>> tags
(Either Float Float)
[1,1]
>>> tags (Bool, Bool)
[4]
>>> tags
(Either Bool Bool)
[2,2]
fromPOSable :: Finite (Choices x) -> Product (Fields x) -> x Source #
default fromPOSable :: (Generic x, GPOSable (SOP I (Code x)), Fields x ~ GFields (SOP I (Code x)), Choices x ~ GChoices (SOP I (Code x))) => Finite (Choices x) -> Product (Fields x) -> x Source #
fields :: x -> Product (Fields x) Source #
default fields :: (Generic x, Fields x ~ GFields (SOP I (Code x)), GPOSable (SOP I (Code x))) => x -> Product (Fields x) Source #
emptyFields :: ProductType (Fields x) Source #
Instances
POSable Bool Source # | |
Defined in Generics.POSable.Instances | |
POSable Double Source # | |
Defined in Examples | |
POSable Float Source # | |
Defined in Examples | |
POSable Ordering Source # | |
Defined in Generics.POSable.Instances | |
POSable () Source # | |
Defined in Generics.POSable.Instances | |
POSable Undef Source # | |
Defined in Generics.POSable.Instances | |
POSable x => POSable (Maybe x) Source # | |
Defined in Generics.POSable.Instances | |
(POSable l, POSable r) => POSable (Either l r) Source # | |
Defined in Generics.POSable.Instances | |
(POSable x0, POSable x1) => POSable (x0, x1) Source # | |
Defined in Generics.POSable.Instances | |
(POSable x0, POSable x1, POSable x2) => POSable (x0, x1, x2) Source # | |
Defined in Generics.POSable.Instances | |
(POSable x0, POSable x1, POSable x2, POSable x3) => POSable (x0, x1, x2, x3) Source # | |
Defined in Generics.POSable.Instances choices :: (x0, x1, x2, x3) -> Finite (Choices (x0, x1, x2, x3)) Source # fromPOSable :: Finite (Choices (x0, x1, x2, x3)) -> Product (Fields (x0, x1, x2, x3)) -> (x0, x1, x2, x3) Source # fields :: (x0, x1, x2, x3) -> Product (Fields (x0, x1, x2, x3)) Source # emptyFields :: ProductType (Fields (x0, x1, x2, x3)) Source # | |
(POSable x0, POSable x1, POSable x2, POSable x3, POSable x4) => POSable (x0, x1, x2, x3, x4) Source # | |
Defined in Generics.POSable.Instances choices :: (x0, x1, x2, x3, x4) -> Finite (Choices (x0, x1, x2, x3, x4)) Source # fromPOSable :: Finite (Choices (x0, x1, x2, x3, x4)) -> Product (Fields (x0, x1, x2, x3, x4)) -> (x0, x1, x2, x3, x4) Source # fields :: (x0, x1, x2, x3, x4) -> Product (Fields (x0, x1, x2, x3, x4)) Source # emptyFields :: ProductType (Fields (x0, x1, x2, x3, x4)) Source # | |
(POSable x0, POSable x1, POSable x2, POSable x3, POSable x4, POSable x5) => POSable (x0, x1, x2, x3, x4, x5) Source # | |
Defined in Generics.POSable.Instances choices :: (x0, x1, x2, x3, x4, x5) -> Finite (Choices (x0, x1, x2, x3, x4, x5)) Source # fromPOSable :: Finite (Choices (x0, x1, x2, x3, x4, x5)) -> Product (Fields (x0, x1, x2, x3, x4, x5)) -> (x0, x1, x2, x3, x4, x5) Source # fields :: (x0, x1, x2, x3, x4, x5) -> Product (Fields (x0, x1, x2, x3, x4, x5)) Source # emptyFields :: ProductType (Fields (x0, x1, x2, x3, x4, x5)) Source # | |
(POSable x0, POSable x1, POSable x2, POSable x3, POSable x4, POSable x5, POSable x6) => POSable (x0, x1, x2, x3, x4, x5, x6) Source # | |
Defined in Generics.POSable.Instances type Choices (x0, x1, x2, x3, x4, x5, x6) :: Nat Source # type Fields (x0, x1, x2, x3, x4, x5, x6) :: [[Type]] Source # choices :: (x0, x1, x2, x3, x4, x5, x6) -> Finite (Choices (x0, x1, x2, x3, x4, x5, x6)) Source # fromPOSable :: Finite (Choices (x0, x1, x2, x3, x4, x5, x6)) -> Product (Fields (x0, x1, x2, x3, x4, x5, x6)) -> (x0, x1, x2, x3, x4, x5, x6) Source # fields :: (x0, x1, x2, x3, x4, x5, x6) -> Product (Fields (x0, x1, x2, x3, x4, x5, x6)) Source # emptyFields :: ProductType (Fields (x0, x1, x2, x3, x4, x5, x6)) Source # | |
(POSable x0, POSable x1, POSable x2, POSable x3, POSable x4, POSable x5, POSable x6, POSable x7) => POSable (x0, x1, x2, x3, x4, x5, x6, x7) Source # | |
Defined in Generics.POSable.Instances type Choices (x0, x1, x2, x3, x4, x5, x6, x7) :: Nat Source # type Fields (x0, x1, x2, x3, x4, x5, x6, x7) :: [[Type]] Source # choices :: (x0, x1, x2, x3, x4, x5, x6, x7) -> Finite (Choices (x0, x1, x2, x3, x4, x5, x6, x7)) Source # fromPOSable :: Finite (Choices (x0, x1, x2, x3, x4, x5, x6, x7)) -> Product (Fields (x0, x1, x2, x3, x4, x5, x6, x7)) -> (x0, x1, x2, x3, x4, x5, x6, x7) Source # fields :: (x0, x1, x2, x3, x4, x5, x6, x7) -> Product (Fields (x0, x1, x2, x3, x4, x5, x6, x7)) Source # emptyFields :: ProductType (Fields (x0, x1, x2, x3, x4, x5, x6, x7)) Source # | |
(POSable x0, POSable x1, POSable x2, POSable x3, POSable x4, POSable x5, POSable x6, POSable x7, POSable x8) => POSable (x0, x1, x2, x3, x4, x5, x6, x7, x8) Source # | |
Defined in Generics.POSable.Instances type Choices (x0, x1, x2, x3, x4, x5, x6, x7, x8) :: Nat Source # type Fields (x0, x1, x2, x3, x4, x5, x6, x7, x8) :: [[Type]] Source # choices :: (x0, x1, x2, x3, x4, x5, x6, x7, x8) -> Finite (Choices (x0, x1, x2, x3, x4, x5, x6, x7, x8)) Source # fromPOSable :: Finite (Choices (x0, x1, x2, x3, x4, x5, x6, x7, x8)) -> Product (Fields (x0, x1, x2, x3, x4, x5, x6, x7, x8)) -> (x0, x1, x2, x3, x4, x5, x6, x7, x8) Source # fields :: (x0, x1, x2, x3, x4, x5, x6, x7, x8) -> Product (Fields (x0, x1, x2, x3, x4, x5, x6, x7, x8)) Source # emptyFields :: ProductType (Fields (x0, x1, x2, x3, x4, x5, x6, x7, x8)) Source # | |
(POSable x0, POSable x1, POSable x2, POSable x3, POSable x4, POSable x5, POSable x6, POSable x7, POSable x8, POSable x9) => POSable (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9) Source # | |
Defined in Generics.POSable.Instances type Choices (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9) :: Nat Source # type Fields (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9) :: [[Type]] Source # choices :: (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9) -> Finite (Choices (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9)) Source # fromPOSable :: Finite (Choices (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9)) -> Product (Fields (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9)) -> (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9) Source # fields :: (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9) -> Product (Fields (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9)) Source # emptyFields :: ProductType (Fields (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9)) Source # | |
(POSable x0, POSable x1, POSable x2, POSable x3, POSable x4, POSable x5, POSable x6, POSable x7, POSable x8, POSable x9, POSable x10) => POSable (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10) Source # | |
Defined in Generics.POSable.Instances type Choices (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10) :: Nat Source # type Fields (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10) :: [[Type]] Source # choices :: (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10) -> Finite (Choices (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10)) Source # fromPOSable :: Finite (Choices (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10)) -> Product (Fields (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10)) -> (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10) Source # fields :: (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10) -> Product (Fields (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10)) Source # emptyFields :: ProductType (Fields (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10)) Source # | |
(POSable x0, POSable x1, POSable x2, POSable x3, POSable x4, POSable x5, POSable x6, POSable x7, POSable x8, POSable x9, POSable x10, POSable x11) => POSable (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11) Source # | |
Defined in Generics.POSable.Instances type Choices (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11) :: Nat Source # type Fields (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11) :: [[Type]] Source # choices :: (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11) -> Finite (Choices (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11)) Source # fromPOSable :: Finite (Choices (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11)) -> Product (Fields (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11)) -> (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11) Source # fields :: (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11) -> Product (Fields (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11)) Source # emptyFields :: ProductType (Fields (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11)) Source # | |
(POSable x0, POSable x1, POSable x2, POSable x3, POSable x4, POSable x5, POSable x6, POSable x7, POSable x8, POSable x9, POSable x10, POSable x11, POSable x12) => POSable (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12) Source # | |
Defined in Generics.POSable.Instances type Choices (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12) :: Nat Source # type Fields (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12) :: [[Type]] Source # choices :: (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12) -> Finite (Choices (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12)) Source # fromPOSable :: Finite (Choices (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12)) -> Product (Fields (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12)) -> (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12) Source # fields :: (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12) -> Product (Fields (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12)) Source # emptyFields :: ProductType (Fields (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12)) Source # | |
(POSable x0, POSable x1, POSable x2, POSable x3, POSable x4, POSable x5, POSable x6, POSable x7, POSable x8, POSable x9, POSable x10, POSable x11, POSable x12, POSable x13) => POSable (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13) Source # | |
Defined in Generics.POSable.Instances type Choices (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13) :: Nat Source # type Fields (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13) :: [[Type]] Source # choices :: (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13) -> Finite (Choices (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13)) Source # fromPOSable :: Finite (Choices (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13)) -> Product (Fields (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13)) -> (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13) Source # fields :: (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13) -> Product (Fields (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13)) Source # emptyFields :: ProductType (Fields (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13)) Source # | |
(POSable x0, POSable x1, POSable x2, POSable x3, POSable x4, POSable x5, POSable x6, POSable x7, POSable x8, POSable x9, POSable x10, POSable x11, POSable x12, POSable x13, POSable x14) => POSable (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14) Source # | |
Defined in Generics.POSable.Instances type Choices (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14) :: Nat Source # type Fields (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14) :: [[Type]] Source # choices :: (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14) -> Finite (Choices (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14)) Source # fromPOSable :: Finite (Choices (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14)) -> Product (Fields (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14)) -> (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14) Source # fields :: (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14) -> Product (Fields (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14)) Source # emptyFields :: ProductType (Fields (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14)) Source # | |
(POSable x0, POSable x1, POSable x2, POSable x3, POSable x4, POSable x5, POSable x6, POSable x7, POSable x8, POSable x9, POSable x10, POSable x11, POSable x12, POSable x13, POSable x14, POSable x15) => POSable (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15) Source # | |
Defined in Generics.POSable.Instances type Choices (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15) :: Nat Source # type Fields (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15) :: [[Type]] Source # choices :: (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15) -> Finite (Choices (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15)) Source # fromPOSable :: Finite (Choices (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15)) -> Product (Fields (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15)) -> (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15) Source # fields :: (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15) -> Product (Fields (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15)) Source # emptyFields :: ProductType (Fields (x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15)) Source # |
class All (SListI :: [Type] -> Constraint) (Code a) => Generic a #
The class of representable datatypes.
The SOP approach to generic programming is based on viewing
datatypes as a representation (Rep
) built from the sum of
products of its components. The components of a datatype
are specified using the Code
type family.
The isomorphism between the original Haskell datatype and its
representation is witnessed by the methods of this class,
from
and to
. So for instances of this class, the following
laws should (in general) hold:
to
.
from
===id
:: a -> afrom
.
to
===id
::Rep
a ->Rep
a
You typically don't define instances of this class by hand, but rather derive the class instance automatically.
Option 1: Derive via the built-in GHC-generics. For this, you
need to use the DeriveGeneric
extension to first derive an
instance of the Generic
class from module GHC.Generics.
With this, you can then give an empty instance for Generic
, and
the default definitions will just work. The pattern looks as
follows:
import qualified GHC.Generics as GHC import Generics.SOP ... data T = ... deriving (GHC.Generic
, ...) instanceGeneric
T -- empty instanceHasDatatypeInfo
T -- empty, if you want/need metadata
Option 2: Derive via Template Haskell. For this, you need to
enable the TemplateHaskell
extension. You can then use
deriveGeneric
from module Generics.SOP.TH
to have the instance generated for you. The pattern looks as
follows:
import Generics.SOP import Generics.SOP.TH ... data T = ...deriveGeneric
''T -- derivesHasDatatypeInfo
as well
Tradeoffs: Whether to use Option 1 or 2 is mainly a matter of personal taste. The version based on Template Haskell probably has less run-time overhead.
Non-standard instances:
It is possible to give Generic
instances manually that deviate
from the standard scheme, as long as at least
to
.
from
===id
:: a -> a
still holds.
Finite number type.
is inhabited by exactly Finite
nn
values. Invariants:
getFinite x < natVal x
getFinite x >= 0
Instances
KnownNat n => Bounded (Finite n) | Throws an error for |
KnownNat n => Enum (Finite n) | |
Eq (Finite n) | |
KnownNat n => Integral (Finite n) | Not modular arithmetic. |
Defined in Data.Finite.Internal | |
KnownNat n => Num (Finite n) | Modular arithmetic. Only the |
Ord (Finite n) | |
Defined in Data.Finite.Internal | |
KnownNat n => Read (Finite n) | |
KnownNat n => Real (Finite n) | |
Defined in Data.Finite.Internal toRational :: Finite n -> Rational # | |
Show (Finite n) | |
Generic (Finite n) | |
NFData (Finite n) | |
Defined in Data.Finite.Internal | |
type Rep (Finite n) | |
Defined in Data.Finite.Internal |