[Haskell-cafe] Fixed point newtype confusion
Sebastien Zany
sebastien at chaoticresearch.com
Tue May 8 02:55:59 CEST 2012
To slightly alter the question, is there a way to define a class
> class (Functor f) => Fixpoint f x where
> ...
so that I can define something with a type signature that looks like
> something :: (Fixpoint f x) => ... x ...
which will accept any
> argument :: F (F (F ... (F a) ... ))
in place of x?
Or alternatively could something analogous be done with type families?
Thanks,
Sebastien
On Mon, May 7, 2012 at 5:45 PM, Sebastien Zany <
sebastien at chaoticresearch.com> wrote:
> Thanks Wren!
>
> When I try
> > fix term
> ghci complains of an ambiguous type variable.
>
> I have to specify
> > term :: (Expr (Expr (Expr (Fix Expr))))
> for it to work.
>
> Is there a way around this?
>
> On Sun, May 6, 2012 at 4:04 PM, wren ng thornton <wren at freegeek.org>wrote:
>
>> On 5/6/12 8:59 AM, Sebastien Zany wrote:
>>
>>> Hi,
>>>
>>> Suppose I have the following types:
>>>
>>> data Expr expr = Lit Nat | Add (expr, expr)
>>>> newtype Fix f = Fix {unFix :: f (Fix f)}
>>>>
>>>
>>> I can construct a sample term:
>>>
>>> term :: Expr (Expr (Expr expr))
>>>> term = Add (Lit 1, Add (Lit 2, Lit 3))
>>>>
>>>
>>> But isn't quite what I need. What I really need is:
>>>
>>> term' :: Fix Expr
>>>> term' = Fix . Add $ (Fix . Lit $ 1, Fix . Add $ (Fix . Lit $ 2, Fix .
>>>> Lit
>>>>
>>> $ 3))
>>>
>>> I feel like there's a stupidly simple way to automatically produce term'
>>> from term, but I'm not seeing it.
>>>
>>
>> There's the smart constructors approach to building term' in the first
>> place, but if someone else is giving you the term and you need to convert
>> it, then you'll need to use a catamorphism (or similar).
>>
>> That is, we already have:
>>
>> Fix :: Expr (Fix Expr) -> Fix Expr
>>
>> but we need to plumb this down through multiple layers:
>>
>> fmap Fix :: Expr (Expr (Fix Expr)) -> Expr (Fix Expr)
>>
>> fmap (fmap Fix) :: Expr (Expr (Expr (Fix Expr)))
>> -> Expr (Expr (Fix Expr))
>>
>> ...
>>
>> If you don't know how many times the incoming term has been unFixed, then
>> you'll need a type class to abstract over the n in fmap^n Fix. How exactly
>> you want to do that will depend on the application, how general it should
>> be, etc. The problem, of course, is that we don't have functor composition
>> for free in Haskell. Francesco's suggestion is probably the easiest:
>>
>> instance Functor Expr where
>> fmap _ (Lit i) = Lit i
>> fmap f (Add e1 e2) = Add (f e1) (f e2)
>>
>> class FixExpr e where
>> fix :: e -> Fix Expr
>>
>> instance FixExpr (Fix Expr) where
>> fix = id
>>
>> instance FixExpr e => FixExpr (Expr e) where
>> fix = Fix . fmap fix
>>
>> Note that the general form of catamorphisms is:
>>
>> cata :: Functor f => (f a -> a) -> Fix f -> a
>> cata f = f . fmap (cata f) . unFix
>>
>> so we're just defining fix = cata Fix, but using induction on the type
>> term itself (via type classes) rather than doing induction on the value
>> term like we usually would.
>>
>> --
>> Live well,
>> ~wren
>>
>>
>> ______________________________**_________________
>> Haskell-Cafe mailing list
>> Haskell-Cafe at haskell.org
>> http://www.haskell.org/**mailman/listinfo/haskell-cafe<http://www.haskell.org/mailman/listinfo/haskell-cafe>
>>
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20120507/7909f600/attachment.htm>
More information about the Haskell-Cafe
mailing list