class Function ?
Lloyd Allison
lloyd@mail.csse.monash.edu.au
Tue, 29 Oct 2002 10:54:30 +1100 (EST)
Almost certainly this is either
. easy and obvious or
. unnecessary or
. impossible
for some a well-known reason. Which is it please? ...
I would like to have a ``class Function'' which has the
operators ``$'', ``.'', etc. and *most* particularly ``'',
so that one can define sub-classes of Function
(e.g. functions having inverses, say) that can still
be applied in the usual way, i.e. ``f x''.
Lloyd
PS. [How] can one make ``->'' an instance of some new class?
--
Lloyd ALLISON, CSSE, Monash University, Victoria, Australia 3168.
web: http://www.csse.monash.edu.au/~lloyd/ tel: +61 3 9905 5205
--
This catches the spirit but falls short at ``f x'' :-
module Main where
-- ------------------------------------------10/2002--L.A.--CSSE--Monash--.au--
-- Would like there to be a ``class Function'' having
-- an apply operator, why not ($), and perhaps others such as (.),
-- with ``->'' being an instance of class Function (as it is of Show 6.1.6)
-- (come to that, how do you make ``->'' an instance of anything new?),
-- and would like to define new instances and subclasses of class Function
-- along the lines of...
class Function fnType where -- would like Function to be in Prelude and
($) :: (fnType t u) -> t -> u -- rather use Prelude's ($) or is it "" ?
apply :: (fnType t u) -> t -> u
f $ x = apply f x -- and then would like to write f x
apply f x = f Main.$ x
data Arrow t u = FN (t->u) -- i.e. ``->''
instance Function Arrow where -- ? in Prelude ?
apply (FN f) x = f x
class (Function fnType) => Invertible fnType where -- a subclass, i.e.
inverse :: fnType t u -> fnType u t -- invertible Functions
data IArrow t u = IFN (t->u) (u->t)
instance Function IArrow where
apply (IFN f i) x = f x
instance Invertible IArrow where
inverse (IFN f i) = IFN i f
successor = IFN (\x -> x+1) (\x -> x-1) -- e.g. an Invertible Function
linRec p f x = -- e.g. yer typical linear recursive schema
let x0 = x -- slightly contrived (OK, a toy)
up x = if p x then dn x else x : (up (apply f x))
dn x = x : if x==x0 then [] else dn (apply (inverse f) x)
in up x0
main = print "L.A., CSSE, Monash, 10/2002: Re a hypothetical class Function"
>> print( successor `apply` 6 ) -- prefer successor 6
>> print( successor Main.$ 6 ) -- prefer successor $ 6
>> print( (inverse successor) `apply` 6 ) -- prefer (inverse successor) 6
>> print( linRec ((<=) 4) successor 1 )
>> print( linRec (\_->True) successor 1 )
-- ----------------------------------------------------------------------------