| Copyright | (C) 2013 Richard Eisenberg |
|---|---|
| License | (C) 2013 Richard Eisenberg |
| Maintainer | Richard Eisenberg (eir@cis.upenn.edu) |
| Stability | experimental |
| Portability | non-portable |
| Safe Haskell | None |
Data.Dimensions.Poly
Description
This module exports all of the definitions you need if you wish to write functions polymorphic over dimension specifications.
Each dimensioned quantity is represented by a member of the type
Dim, which is parameterized by a type-level list of DimSpecs.
A DimSpec, in turn, is a unit type paired with its exponent,
representented with a type-level Z. The unit types should all be
canonical -- that is, the base unit of all compatible units. Thus,
the type of velocity in the SI system would be
Dim '[D Meter One, D Second MOne].
A technical detail: because DimSpec is used only at the type level
and needs to store types of kind *, it must be parameterized, as we
can't specify * in its declaration. (See "The Right Kind of Generic
Programming", by José Pedro Magalhães, published at WGP'12, for more
explanation.) So, we always work with (DimSpec *)s.
- data Dim n a
- data DimSpec star = D star Z
- type family a ($=) b :: Bool
- type family Extract s lst :: ([DimSpec *], Maybe (DimSpec *))
- type family Reorder a b :: [DimSpec *]
- type family a (@~) b :: Constraint
- type family Normalize d :: [DimSpec *]
- type family a (@+) b :: [DimSpec *]
- type family a (@-) b :: [DimSpec *]
- type family NegDim a :: DimSpec *
- type family NegList a :: [DimSpec *]
- type family base (@*) power :: [DimSpec *]
- type family dims (@/) z :: [DimSpec *]
The Dim type
Dim adds a dimensional annotation to its base type n. This is the
representation for all dimensioned quantities.
Instances
| Eq n => Eq (Dim n ([] (DimSpec *))) | |
| Floating n => Floating (Dim n ([] (DimSpec *))) | |
| Fractional n => Fractional (Dim n ([] (DimSpec *))) | |
| Num n => Num (Dim n ([] (DimSpec *))) | |
| Ord n => Ord (Dim n ([] (DimSpec *))) | |
| Real n => Real (Dim n ([] (DimSpec *))) | |
| RealFloat n => RealFloat (Dim n ([] (DimSpec *))) | |
| RealFrac n => RealFrac (Dim n ([] (DimSpec *))) | |
| (ShowDimSpec dims, Show n) => Show (Dim n dims) |
Maniuplating dimension specifications
This will only be used at the kind level. It holds a dimension with its exponent.
Instances
| Eq n => Eq (Dim n ([] (DimSpec *))) | |
| Floating n => Floating (Dim n ([] (DimSpec *))) | |
| Fractional n => Fractional (Dim n ([] (DimSpec *))) | |
| Num n => Num (Dim n ([] (DimSpec *))) | |
| Ord n => Ord (Dim n ([] (DimSpec *))) | |
| Real n => Real (Dim n ([] (DimSpec *))) | |
| RealFloat n => RealFloat (Dim n ([] (DimSpec *))) | |
| RealFrac n => RealFrac (Dim n ([] (DimSpec *))) |
type family Extract s lst :: ([DimSpec *], Maybe (DimSpec *))Source
(Extract s lst) pulls the DimSpec that matches s out of lst, returning a
diminished list and, possibly, the extracted DimSpec.
Extract A [A, B, C] ==> ([B, C], Just A Extract D [A, B, C] ==> ([A, B, C], Nothing)
type family Reorder a b :: [DimSpec *]Source
Reorders a to be the in the same order as b, putting entries not in b at the end
Reorder [A 1, B 2] [B 5, A 2] ==> [B 2, A 1] Reorder [A 1, B 2, C 3] [C 2, A 8] ==> [C 3, A 1, B 2] Reorder [A 1, B 2] [B 4, C 1, A 9] ==> [B 2, A 1] Reorder x x ==> x Reorder x [] ==> x Reorder [] x ==> []
type family a (@~) b :: ConstraintSource
Check if two [DimSpec *]s should be considered to be equal
type family Normalize d :: [DimSpec *]Source
Take a [DimSpec *] and remove any DimSpecs with an exponent of 0