[Haskell-cafe] CCC MyType
Lafras Uys
lafras at aims.ac.za
Wed Sep 22 10:57:42 EDT 2010
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
List,
I'm trying to wrap my head around Haskell and Category Theory---very new
to both and in keeping with character, I've jumped into the deep-end.
The categories and category-extras packages have helped to illustrate
some concepts. However, I remain confused and hope someone can point me
in the right direction.
The ultimate goal is to construct my own instance of a CCC. Here is the
class definition for CCC from the categories package:
> class ( Cartesian (<=)
> , Symmetric (<=) (Product (<=))
> , Monoidal (<=) (Product (<=))
> ) => CCC (<=) where
> type Exp (<=) :: * -> * -> *
> apply :: (Product (<=) (Exp (<=) a b) a) <= b
> curry :: ((Product (<=) a b) <= c) -> a <= Exp (<=) b c
> uncurry :: (a <= (Exp (<=) b c)) -> (Product (<=>) a b <= c)
I have the following:
> {-# LANGUAGE TypeFamilies,
> MultiParamTypeClasses,
> UndecidableInstances #-}
> import Control.Category.Braided
> import Control.Category.Associative
> import Control.Category.Cartesian
> import Control.Category.Monoidal
> import Control.Category.Cartesian.Closed
> data MyType a b = MyType {f::(a -> b)}
> data SomeType a b = SomeType {g::(a,b)}
> instance (Symmetric MyType (Product MyType),
> Monoidal MyType (Product MyType),
> PreCartesian MyType) => CCC MyType where
> type Exp MyType = SomeType
It type checks in ghci and gives the appropriate warnings that apply,
curry and uncurry have not been defined---I can't see how to define
these. Is it actually possible with the two data types I have?
I would really appreciate some help.
Lafras
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.10 (GNU/Linux)
Comment: Using GnuPG with Mozilla - http://enigmail.mozdev.org/
iEYEARECAAYFAkyaGWYACgkQKUpCd+bV+kqgWgCfY7B7pUttB0xfeOAN1V3NDqRL
fgQAniK/EJsV9jS7XWxmxElCVD6AW0as
=l0x/
-----END PGP SIGNATURE-----
More information about the Haskell-Cafe
mailing list