Agda-2.5.3.20180519: A dependently typed functional programming language and proof assistant

Safe HaskellNone
LanguageHaskell2010

Agda.Utils.TypeLevel

Synopsis

Documentation

type family All (p :: k -> Constraint) (as :: [k]) :: Constraint where ... Source #

All p as ensures that the constraint p is satisfied by all the types in as. (Types is between scare-quotes here because the code is actually kind polymorphic)

Equations

All p '[] = () 
All p (a ': as) = (p a, All p as) 

type family If (b :: Bool) (l :: k) (r :: k) :: k where ... Source #

On Booleans

Equations

If True l r = l 
If False l r = r 

type family Foldr (c :: k -> l -> l) (n :: l) (as :: [k]) :: l where ... Source #

On Lists

Equations

Foldr c n '[] = n 
Foldr c n (a ': as) = c a (Foldr c n as) 

type family Foldr' (c :: Function k (Function l l -> *) -> *) (n :: l) (as :: [k]) :: l where ... Source #

Version of Foldr taking a defunctionalised argument so that we can use partially applied functions.

Equations

Foldr' c n '[] = n 
Foldr' c n (a ': as) = Apply (Apply c a) (Foldr' c n as) 

type family Map (f :: Function k l -> *) (as :: [k]) :: [l] where ... Source #

Equations

Map f as = Foldr' (ConsMap0 f) '[] as 

data ConsMap0 :: (Function k l -> *) -> Function k (Function [l] [l] -> *) -> * Source #

Instances

type Apply k (Function [l] [l] -> *) (ConsMap0 k l f) a Source # 
type Apply k (Function [l] [l] -> *) (ConsMap0 k l f) a = ConsMap1 k l f a

data ConsMap1 :: (Function k l -> *) -> k -> Function [l] [l] -> * Source #

Instances

type Apply [a1] [a1] (ConsMap1 k a1 f a2) tl Source # 
type Apply [a1] [a1] (ConsMap1 k a1 f a2) tl = (:) a1 (Apply k a1 f a2) tl

type family Constant (b :: l) (as :: [k]) :: [l] where ... Source #

Equations

Constant b as = Map (Constant1 b) as 

type Arrows (as :: [*]) (r :: *) = Foldr (->) r as Source #

Arrows [a1,..,an] r corresponds to a1 -> .. -> an -> r | Products [a1,..,an] corresponds to (a1, (..,( an, ())..))

type Products (as :: [*]) = Foldr (,) () as Source #

type family IsBase (t :: *) :: Bool where ... Source #

IsBase t is 'True whenever t is *not* a function space.

Equations

IsBase (a -> t) = False 
IsBase a = True 

type family Domains (t :: *) :: [*] where ... Source #

Using IsBase we can define notions of Domains and CoDomains which *reduce* under positive information IsBase t ~ 'True even though the shape of t is not formally exposed

Equations

Domains t = If (IsBase t) '[] (Domains' t) 

type family Domains' (t :: *) :: [*] where ... Source #

Equations

Domains' (a -> t) = a ': Domains t 

type family CoDomain (t :: *) :: * where ... Source #

Equations

CoDomain t = If (IsBase t) t (CoDomain' t) 

type family CoDomain' (t :: *) :: * where ... Source #

Equations

CoDomain' (a -> t) = CoDomain t 

class Currying as b where Source #

Currying as b witnesses the isomorphism between Arrows as b and Products as -> b. It is defined as a type class rather than by recursion on a singleton for as so all of that these conversions are inlined at compile time for concrete arguments.

Minimal complete definition

uncurrys, currys

Methods

uncurrys :: Proxy as -> Proxy b -> Arrows as b -> Products as -> b Source #

currys :: Proxy as -> Proxy b -> (Products as -> b) -> Arrows as b Source #

Instances

Currying ([] *) b Source # 

Methods

uncurrys :: Proxy [*] [*] -> Proxy * b -> Arrows [*] b -> Products [*] -> b Source #

currys :: Proxy [*] [*] -> Proxy * b -> (Products [*] -> b) -> Arrows [*] b Source #

Currying as b => Currying ((:) * a as) b Source # 

Methods

uncurrys :: Proxy [*] ((* ': a) as) -> Proxy * b -> Arrows ((* ': a) as) b -> Products ((* ': a) as) -> b Source #

currys :: Proxy [*] ((* ': a) as) -> Proxy * b -> (Products ((* ': a) as) -> b) -> Arrows ((* ': a) as) b Source #

data Function :: * -> * -> * Source #

Instances

type Apply * (Function b * -> *) (Constant0 b *) a Source # 
type Apply * (Function b * -> *) (Constant0 b *) a = Constant1 b * a
type Apply k (Function [l] [l] -> *) (ConsMap0 k l f) a Source # 
type Apply k (Function [l] [l] -> *) (ConsMap0 k l f) a = ConsMap1 k l f a

data Constant0 :: Function a (Function b a -> *) -> * Source #

Instances

type Apply * (Function b * -> *) (Constant0 b *) a Source # 
type Apply * (Function b * -> *) (Constant0 b *) a = Constant1 b * a

data Constant1 :: * -> Function b a -> * Source #

Instances

type Apply k * (Constant1 k * a) b Source # 
type Apply k * (Constant1 k * a) b = a

type family Apply (t :: Function k l -> *) (u :: k) :: l Source #

Instances

type Apply k * (Constant1 k * a) b Source # 
type Apply k * (Constant1 k * a) b = a
type Apply * (Function b * -> *) (Constant0 b *) a Source # 
type Apply * (Function b * -> *) (Constant0 b *) a = Constant1 b * a
type Apply k (Function [l] [l] -> *) (ConsMap0 k l f) a Source # 
type Apply k (Function [l] [l] -> *) (ConsMap0 k l f) a = ConsMap1 k l f a
type Apply [a1] [a1] (ConsMap1 k a1 f a2) tl Source # 
type Apply [a1] [a1] (ConsMap1 k a1 f a2) tl = (:) a1 (Apply k a1 f a2) tl