Re: [Haskell-cafe] f^n for functional iteration

Agreeing with the analysis, I will sharpen my question. Is option 2 possible at all, regardless of sanity concerns (e.g. incomplete implementation of Num). Doug
On Tue, 10 Dec 2013 at 10:51 AM, Danny Gratzer
wrote Well (^) is already used for their traditional meaning and using this exact operator would require
1. Shadowing (^) from prelude 2. Making (a -> a) an instance of Num (impossible to do sanely)
You can just use a different operator
f .^. n = foldl (.) id $ replicate n f
On Tue, Dec 10, 2013 at 10:45 AM, Doug McIlroy
wrote: Is there a trick whereby the customary notation f^n for iterated functional composition ((\n f -> foldl (.) id (replicate n f)) n f) can be defined in Haskell?
Doug McIlroy

This seems to work {-# LANGUAGE FlexibleInstances #-} instance Num (a -> a) where (*) = (.) Of course, using anything else from the Num class will blow up in your face so it's probably not worth it. Cheers, Danny Gratzer

On Wed, Dec 11, 2013 at 10:48 PM, Danny Gratzer
This seems to work
{-# LANGUAGE FlexibleInstances #-} instance Num (a -> a) where (*) = (.)
Of course, using anything else from the Num class will blow up in your face so it's probably not worth it.
And the hidden danger is that Num is special cased such that the compiler more or less has an open license to infer Num instances all over the place (see: defaulting, and its interaction with the monomorphism restriction), and as a result it will infer things you would never have imagined. In other words, the price of this is that type inference is no longer reliable and type errors will be reported incomprehensibly, depending on how consistently you specify type signatures (that is, the more you have, the more comprehensible the errors; but few people actually use type signatures *everywhere* they can be specified). -- brandon s allbery kf8nh sine nomine associates allbery.b@gmail.com ballbery@sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net

Doug McIlroy
Agreeing with the analysis, I will sharpen my question. Is option 2 possible at all, regardless of sanity concerns (e.g. incomplete implementation of Num).
Doug
On Tue, 10 Dec 2013 at 10:51 AM, Danny Gratzer
wrote Well (^) is already used for their traditional meaning and using this exact operator would require
1. Shadowing (^) from prelude 2. Making (a -> a) an instance of Num (impossible to do sanely)
You can just use a different operator
f .^. n = foldl (.) id $ replicate n f
On Tue, Dec 10, 2013 at 10:45 AM, Doug McIlroy
wrote: Is there a trick whereby the customary notation f^n for iterated functional composition ((\n f -> foldl (.) id (replicate n f)) n f) can be defined in Haskell?
Doug McIlroy

@Antonio, that defines sane instances for (a -> a), he needs [f ^ x] to be
[f . f . f . f . ....] which means that [f * f] is [f . f] not the [liftA2
(*)] that they use.
Cheers,
Danny Gratzer
On Fri, Dec 13, 2013 at 8:59 AM, Antonio Nikishaev
Doug McIlroy
writes: http://hackage.haskell.org/package/NumInstances
Agreeing with the analysis, I will sharpen my question. Is option 2 possible at all, regardless of sanity concerns (e.g. incomplete implementation of Num).
Doug
On Tue, 10 Dec 2013 at 10:51 AM, Danny Gratzer
wrote Well (^) is already used for their traditional meaning and using this exact operator would require
1. Shadowing (^) from prelude 2. Making (a -> a) an instance of Num (impossible to do sanely)
You can just use a different operator
f .^. n = foldl (.) id $ replicate n f
On Tue, Dec 10, 2013 at 10:45 AM, Doug McIlroy
Is there a trick whereby the customary notation f^n for iterated functional composition ((\n f -> foldl (.) id (replicate n f)) n f) can be defined in Haskell?
Doug McIlroy
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
participants (4)
-
Antonio Nikishaev
-
Brandon Allbery
-
Danny Gratzer
-
Doug McIlroy