Basic question concerning the category Hask (was: concerning data constructors)

Hi Andrew, Andrew Bromage wrote:
I still say it "isn't a set" in the same way that a group "isn't a set". Haskell data types have structure that is respected by Haskell homomorphisms. Sets don't.
Ah, that's certainly true. But what is that additional structure? In categories that have a forgetful functor to Set, the interesting part of their structure comes from the fact that their morphisms are only a proper subset of the morphisms in Set. So in what way are Set morphisms restricted from being Hask morphisms? In two ways, I think: 1. They must be computable. 2. They must satisfy certain strictness criteria involving undefined and seq. (1) can be rather boring, since computability is rarely is an issue in real-life programming problems. It seems that some people using concepts from categories in Haskell would prefer to ignore (2) as well. If so, we have been reduced to viewing Hask as more or less the same as a small subcategory of Set, with no additional structure that is of interest. In this view, there is nothing special about Haskell, except for the fact that category-theoretic concepts are a bit easier to express in Haskell than in many other languages. So perhaps a better name for this category would be Turing. I don't think that ignoring (2) is the right approach. I would like Hask to reflect the non-strict nature of Haskell, which is one of its most interesting features. Some people are worried that this version of Hask is missing certain nice properties that one would like to have. For example, it was recently claimed on this list that tuples are not products in that category. (Or some such. I would be interested to see a demonstration of that.) I am not impressed by those complaints. As usual in category theory, you define corresponding notions in Hask, and prove that they are preserved under the appropriate functors. That should always be easy. And if ever it is not, then you have discovered an interesting non-trivial consequence of laziness that deserves study. For example: I think that "monads" in Haskell should satisfy the monad laws in Hask, not just after applying the forgetful functor to Turing. That means that (>>=) must be strict in its second argument. That would very likely not break any existing programs, yet almost none of the existing monads satisfy this, not even IO. Regards, Yitz

On 2 Jan 2008, at 5:49 AM, Yitzchak Gale wrote:
Hi Andrew,
Andrew Bromage wrote:
I still say it "isn't a set" in the same way that a group "isn't a set". Haskell data types have structure that is respected by Haskell homomorphisms. Sets don't.
Ah, that's certainly true. But what is that additional structure?
In categories that have a forgetful functor to Set, the interesting part of their structure comes from the fact that their morphisms are only a proper subset of the morphisms in Set.
So in what way are Set morphisms restricted from being Hask morphisms?
The normal view taken by Haskellers is that the denotations of Haskell types are CPPOs. So: (1) Must be monotone (2) Must be continuous (Needn't be strict, even though that messes up the resulting category substantially). jcc

Hi Jonathan, I wrote:
So in what way are Set morphisms restricted from being Hask morphisms?
Jonathan Cast wrote:
The normal view taken by Haskellers is that the denotations of Haskell types are CPPOs.
CPPO?
So:
(1) Must be monotone (2) Must be continuous
Could you please define what you mean by those terms in this context?
(Needn't be strict, even though that messes up the resulting category substantially).
I'm not convinced that the category is all that "messed up". Thanks, Yitz

Jonathan Cast wrote:
The normal view taken by Haskellers is that the denotations of Haskell types are CPPOs.
I wrote:
CPPO?
(1) Must be monotone (2) Must be continuous
Could you please define what you mean by those terms in this context?
Jens Blanck wrote:
The extra P would stand for "pointed" (has a least element, bottom), this is common in some communities. To me though, a cpo (complete partial order) is closed under directed suprema and the empty set is directed so bottom is already required. The category of cpos in not cartesian closed. For denotational semantics I believe the subcategory of Scott domains are what is usually considered.
Continuous functions on cpos are by definition monotone and they respect directed suprema.
Thanks! Yitz

I'm trying to translate some standard C# constucts into Haskell... some of this seems easy.... Specifically 1) Interface IX { } 2) Interface IX<A> { } 3) Interface IX<A> Where A : IY { } 4) Interface IX<A> : IZ Where A : IY { } I can take a punt at the first 2....but then it all falls apart

Of course it depends what's inside the braces, and what you want to do with
it, but I'd be inclined to do something like this:
1) data IX a = IX { constructor :: Int -> a, ... }
2) data IX a b = IX { constructor :: Int -> b, func :: a -> b, ... }
3) data IX a b = IX { iy :: IY a, ... }
4) data IX a b = IX { iz :: IZ b, iy :: IY a, ... }
Can you specify more clearly what the goal of the conversion is? If you
want "OO" style behavior the thing that is most important is existential
quantification.
-- ryan
On 1/2/08, Nicholls, Mark
I'm trying to translate some standard C# constucts into Haskell... some of this seems easy....
Specifically
1)
Interface IX { }
2)
Interface IX<A> { }
3)
Interface IX<A> Where A : IY { }
4)
Interface IX<A> : IZ Where A : IY { }
I can take a punt at the first 2....but then it all falls apart _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

I was thinking more along type classes....and then I was going to throw
some spanners in the works....
________________________________
From: Ryan Ingram [mailto:ryani.spam@gmail.com]
Sent: 02 January 2008 17:41
To: Nicholls, Mark
Cc: haskell-cafe@haskell.org
Subject: Re: [Haskell-cafe] Is there anyone out there who can translate
C# generics into Haskell?
Of course it depends what's inside the braces, and what you want to do
with it, but I'd be inclined to do something like this:
1) data IX a = IX { constructor :: Int -> a, ... }
2) data IX a b = IX { constructor :: Int -> b, func :: a -> b, ... }
3) data IX a b = IX { iy :: IY a, ... }
4) data IX a b = IX { iz :: IZ b, iy :: IY a, ... }
Can you specify more clearly what the goal of the conversion is? If you
want "OO" style behavior the thing that is most important is existential
quantification.
-- ryan
On 1/2/08, Nicholls, Mark

Hello Mark, Wednesday, January 2, 2008, 7:40:31 PM, you wrote:
I'm trying to translate some standard C# constucts into Haskell... some
it's meaningless. read http://haskell.org/haskellwiki/OOP_vs_type_classes and especially papers mentioned in the References -- Best regards, Bulat mailto:Bulat.Ziganshin@gmail.com

Can you give me a summary of why it's meaningless.....both would seem to describe/construct values/objects....they may not be equivalent, but I would expect some considerable overlap. -----Original Message----- From: Bulat Ziganshin [mailto:bulat.ziganshin@gmail.com] Sent: 02 January 2008 20:29 To: Nicholls, Mark Cc: haskell-cafe@haskell.org Subject: Re: [Haskell-cafe] Is there anyone out there who can translate C# generics into Haskell? Hello Mark, Wednesday, January 2, 2008, 7:40:31 PM, you wrote:
I'm trying to translate some standard C# constucts into Haskell... some
it's meaningless. read http://haskell.org/haskellwiki/OOP_vs_type_classes and especially papers mentioned in the References -- Best regards, Bulat mailto:Bulat.Ziganshin@gmail.com

Hello Mark, Thursday, January 3, 2008, 1:22:26 PM, you wrote: because they have different models. i recommend you to start from learning this model, otherwise you will don't understand how Haskell really works and erroneously apply your OOP knowledge to Haskell data structures. shortly said, there are 3 ways to polymorphism: 1) C++ templates - type-specific code generated at compile time 2) OOP classes - every object carries VMT which allows to select type-specific operation 3) type classes - dictionary of type-specific operations is given as additional hidden argument to each function Haskell uses t.c. and its abilities are dictated by this implementation. there is no simple and direct mapping between features provided by OOP and t.c.
Can you give me a summary of why it's meaningless.....both would seem to describe/construct values/objects....they may not be equivalent, but I would expect some considerable overlap.
-----Original Message----- From: Bulat Ziganshin [mailto:bulat.ziganshin@gmail.com] Sent: 02 January 2008 20:29 To: Nicholls, Mark Cc: haskell-cafe@haskell.org Subject: Re: [Haskell-cafe] Is there anyone out there who can translate C# generics into Haskell?
Hello Mark,
Wednesday, January 2, 2008, 7:40:31 PM, you wrote:
I'm trying to translate some standard C# constucts into Haskell... some
it's meaningless. read http://haskell.org/haskellwiki/OOP_vs_type_classes and especially papers mentioned in the References
-- Best regards, Bulat mailto:Bulat.Ziganshin@gmail.com

I loosely do understand....but very loosely....but I'm not, as yet, convinced it is completely relevant. The implementation may differ, but that does not mean that there is no overlap....I am not expecting one model to be a superset of the other, but I am expecting some sort of overlap between 'interface' implementation and type class instance declaration. -----Original Message----- From: Bulat Ziganshin [mailto:bulat.ziganshin@gmail.com] Sent: 03 January 2008 10:54 To: Nicholls, Mark Cc: Bulat Ziganshin; haskell-cafe@haskell.org Subject: Re[2]: [Haskell-cafe] Is there anyone out there who can translate C# generics into Haskell? Hello Mark, Thursday, January 3, 2008, 1:22:26 PM, you wrote: because they have different models. i recommend you to start from learning this model, otherwise you will don't understand how Haskell really works and erroneously apply your OOP knowledge to Haskell data structures. shortly said, there are 3 ways to polymorphism: 1) C++ templates - type-specific code generated at compile time 2) OOP classes - every object carries VMT which allows to select type-specific operation 3) type classes - dictionary of type-specific operations is given as additional hidden argument to each function Haskell uses t.c. and its abilities are dictated by this implementation. there is no simple and direct mapping between features provided by OOP and t.c.
Can you give me a summary of why it's meaningless.....both would seem to describe/construct values/objects....they may not be equivalent, but I would expect some considerable overlap.
-----Original Message----- From: Bulat Ziganshin [mailto:bulat.ziganshin@gmail.com] Sent: 02 January 2008 20:29 To: Nicholls, Mark Cc: haskell-cafe@haskell.org Subject: Re: [Haskell-cafe] Is there anyone out there who can translate C# generics into Haskell?
Hello Mark,
Wednesday, January 2, 2008, 7:40:31 PM, you wrote:
I'm trying to translate some standard C# constucts into Haskell... some
it's meaningless. read http://haskell.org/haskellwiki/OOP_vs_type_classes and especially papers mentioned in the References
-- Best regards, Bulat mailto:Bulat.Ziganshin@gmail.com

Hello Mark, Thursday, January 3, 2008, 2:13:08 PM, you wrote: of course *some* overlap exists but in order to understand it you should know exact shape of both methods when i tried to develop complex library without understanding t.c. implementation, i constantly goes into the troubles - things that i (using my OOP experience) considered as possible, was really impossible in Haskell so i'm really wonder why you don't want to learn the topic thoroughly
I loosely do understand....but very loosely....but I'm not, as yet, convinced it is completely relevant.
The implementation may differ, but that does not mean that there is no overlap....I am not expecting one model to be a superset of the other, but I am expecting some sort of overlap between 'interface' implementation and type class instance declaration.
-----Original Message----- From: Bulat Ziganshin [mailto:bulat.ziganshin@gmail.com] Sent: 03 January 2008 10:54 To: Nicholls, Mark Cc: Bulat Ziganshin; haskell-cafe@haskell.org Subject: Re[2]: [Haskell-cafe] Is there anyone out there who can translate C# generics into Haskell?
Hello Mark,
Thursday, January 3, 2008, 1:22:26 PM, you wrote:
because they have different models. i recommend you to start from learning this model, otherwise you will don't understand how Haskell really works and erroneously apply your OOP knowledge to Haskell data structures.
shortly said, there are 3 ways to polymorphism:
1) C++ templates - type-specific code generated at compile time 2) OOP classes - every object carries VMT which allows to select type-specific operation 3) type classes - dictionary of type-specific operations is given as additional hidden argument to each function
Haskell uses t.c. and its abilities are dictated by this implementation. there is no simple and direct mapping between features provided by OOP and t.c.
Can you give me a summary of why it's meaningless.....both would seem to describe/construct values/objects....they may not be equivalent, but I would expect some considerable overlap.
-----Original Message----- From: Bulat Ziganshin [mailto:bulat.ziganshin@gmail.com] Sent: 02 January 2008 20:29 To: Nicholls, Mark Cc: haskell-cafe@haskell.org Subject: Re: [Haskell-cafe] Is there anyone out there who can translate C# generics into Haskell?
Hello Mark,
Wednesday, January 2, 2008, 7:40:31 PM, you wrote:
I'm trying to translate some standard C# constucts into Haskell... some
it's meaningless. read http://haskell.org/haskellwiki/OOP_vs_type_classes and especially papers mentioned in the References
-- Best regards, Bulat mailto:Bulat.Ziganshin@gmail.com

I do not necessarily disagree.... But if I can identify the overlap....then I have leant the overlap...on the cheap. -----Original Message----- From: Bulat Ziganshin [mailto:bulat.ziganshin@gmail.com] Sent: 03 January 2008 14:39 To: Nicholls, Mark Cc: Bulat Ziganshin; haskell-cafe@haskell.org Subject: Re[4]: [Haskell-cafe] Is there anyone out there who can translate C# generics into Haskell? Hello Mark, Thursday, January 3, 2008, 2:13:08 PM, you wrote: of course *some* overlap exists but in order to understand it you should know exact shape of both methods when i tried to develop complex library without understanding t.c. implementation, i constantly goes into the troubles - things that i (using my OOP experience) considered as possible, was really impossible in Haskell so i'm really wonder why you don't want to learn the topic thoroughly
I loosely do understand....but very loosely....but I'm not, as yet, convinced it is completely relevant.
The implementation may differ, but that does not mean that there is no overlap....I am not expecting one model to be a superset of the other, but I am expecting some sort of overlap between 'interface' implementation and type class instance declaration.
-----Original Message----- From: Bulat Ziganshin [mailto:bulat.ziganshin@gmail.com] Sent: 03 January 2008 10:54 To: Nicholls, Mark Cc: Bulat Ziganshin; haskell-cafe@haskell.org Subject: Re[2]: [Haskell-cafe] Is there anyone out there who can translate C# generics into Haskell?
Hello Mark,
Thursday, January 3, 2008, 1:22:26 PM, you wrote:
because they have different models. i recommend you to start from learning this model, otherwise you will don't understand how Haskell really works and erroneously apply your OOP knowledge to Haskell data structures.
shortly said, there are 3 ways to polymorphism:
1) C++ templates - type-specific code generated at compile time 2) OOP classes - every object carries VMT which allows to select type-specific operation 3) type classes - dictionary of type-specific operations is given as additional hidden argument to each function
Haskell uses t.c. and its abilities are dictated by this implementation. there is no simple and direct mapping between features provided by OOP and t.c.
Can you give me a summary of why it's meaningless.....both would seem to describe/construct values/objects....they may not be equivalent, but I would expect some considerable overlap.
-----Original Message----- From: Bulat Ziganshin [mailto:bulat.ziganshin@gmail.com] Sent: 02 January 2008 20:29 To: Nicholls, Mark Cc: haskell-cafe@haskell.org Subject: Re: [Haskell-cafe] Is there anyone out there who can translate C# generics into Haskell?
Hello Mark,
Wednesday, January 2, 2008, 7:40:31 PM, you wrote:
I'm trying to translate some standard C# constucts into Haskell... some
it's meaningless. read http://haskell.org/haskellwiki/OOP_vs_type_classes and especially papers mentioned in the References
-- Best regards, Bulat mailto:Bulat.Ziganshin@gmail.com

On 3 Jan 2008, at 7:40 AM, Nicholls, Mark wrote:
I do not necessarily disagree....
But if I can identify the overlap....then I have leant the overlap...on the cheap.
Not really. You still don't have the context which allows you to fit the Haskell features into a complete system. Meaning is derived from context, it's not inherent --- and the meaning and use of even those features that translate between Haskell and C++ is completely different, because the context they need to fit into makes them suitable for different sorts of applications. jcc

Hello Mark, Thursday, January 3, 2008, 6:40:13 PM, you wrote: it would be hard to understand overlap without knowing both systems. you will believe that you understand it, but things will go strange ways :)
I do not necessarily disagree....
But if I can identify the overlap....then I have leant the overlap...on the cheap.
-----Original Message----- From: Bulat Ziganshin [mailto:bulat.ziganshin@gmail.com] Sent: 03 January 2008 14:39 To: Nicholls, Mark Cc: Bulat Ziganshin; haskell-cafe@haskell.org Subject: Re[4]: [Haskell-cafe] Is there anyone out there who can translate C# generics into Haskell?
Hello Mark,
Thursday, January 3, 2008, 2:13:08 PM, you wrote:
of course *some* overlap exists but in order to understand it you should know exact shape of both methods
when i tried to develop complex library without understanding t.c. implementation, i constantly goes into the troubles - things that i (using my OOP experience) considered as possible, was really impossible in Haskell
so i'm really wonder why you don't want to learn the topic thoroughly
I loosely do understand....but very loosely....but I'm not, as yet, convinced it is completely relevant.
The implementation may differ, but that does not mean that there is no overlap....I am not expecting one model to be a superset of the other, but I am expecting some sort of overlap between 'interface' implementation and type class instance declaration.
-----Original Message----- From: Bulat Ziganshin [mailto:bulat.ziganshin@gmail.com] Sent: 03 January 2008 10:54 To: Nicholls, Mark Cc: Bulat Ziganshin; haskell-cafe@haskell.org Subject: Re[2]: [Haskell-cafe] Is there anyone out there who can translate C# generics into Haskell?
Hello Mark,
Thursday, January 3, 2008, 1:22:26 PM, you wrote:
because they have different models. i recommend you to start from learning this model, otherwise you will don't understand how Haskell really works and erroneously apply your OOP knowledge to Haskell data structures.
shortly said, there are 3 ways to polymorphism:
1) C++ templates - type-specific code generated at compile time 2) OOP classes - every object carries VMT which allows to select type-specific operation 3) type classes - dictionary of type-specific operations is given as additional hidden argument to each function
Haskell uses t.c. and its abilities are dictated by this implementation. there is no simple and direct mapping between features provided by OOP and t.c.
Can you give me a summary of why it's meaningless.....both would seem to describe/construct values/objects....they may not be equivalent, but I would expect some considerable overlap.
-----Original Message----- From: Bulat Ziganshin [mailto:bulat.ziganshin@gmail.com] Sent: 02 January 2008 20:29 To: Nicholls, Mark Cc: haskell-cafe@haskell.org Subject: Re: [Haskell-cafe] Is there anyone out there who can translate C# generics into Haskell?
Hello Mark,
Wednesday, January 2, 2008, 7:40:31 PM, you wrote:
I'm trying to translate some standard C# constucts into Haskell... some
it's meaningless. read http://haskell.org/haskellwiki/OOP_vs_type_classes and especially papers mentioned in the References
-- Best regards, Bulat mailto:Bulat.Ziganshin@gmail.com

You may be right...but learning is not an atomic thing....wherever I start I will get strange things happening. -----Original Message----- From: Bulat Ziganshin [mailto:bulat.ziganshin@gmail.com] Sent: 03 January 2008 18:59 To: Nicholls, Mark Cc: Bulat Ziganshin; haskell-cafe@haskell.org Subject: Re[6]: [Haskell-cafe] Is there anyone out there who can translate C# generics into Haskell? Hello Mark, Thursday, January 3, 2008, 6:40:13 PM, you wrote: it would be hard to understand overlap without knowing both systems. you will believe that you understand it, but things will go strange ways :)
I do not necessarily disagree....
But if I can identify the overlap....then I have leant the overlap...on the cheap.
-----Original Message----- From: Bulat Ziganshin [mailto:bulat.ziganshin@gmail.com] Sent: 03 January 2008 14:39 To: Nicholls, Mark Cc: Bulat Ziganshin; haskell-cafe@haskell.org Subject: Re[4]: [Haskell-cafe] Is there anyone out there who can translate C# generics into Haskell?
Hello Mark,
Thursday, January 3, 2008, 2:13:08 PM, you wrote:
of course *some* overlap exists but in order to understand it you should know exact shape of both methods
when i tried to develop complex library without understanding t.c. implementation, i constantly goes into the troubles - things that i (using my OOP experience) considered as possible, was really impossible in Haskell
so i'm really wonder why you don't want to learn the topic thoroughly
I loosely do understand....but very loosely....but I'm not, as yet, convinced it is completely relevant.
The implementation may differ, but that does not mean that there is no overlap....I am not expecting one model to be a superset of the other, but I am expecting some sort of overlap between 'interface' implementation and type class instance declaration.
-----Original Message----- From: Bulat Ziganshin [mailto:bulat.ziganshin@gmail.com] Sent: 03 January 2008 10:54 To: Nicholls, Mark Cc: Bulat Ziganshin; haskell-cafe@haskell.org Subject: Re[2]: [Haskell-cafe] Is there anyone out there who can translate C# generics into Haskell?
Hello Mark,
Thursday, January 3, 2008, 1:22:26 PM, you wrote:
because they have different models. i recommend you to start from learning this model, otherwise you will don't understand how Haskell really works and erroneously apply your OOP knowledge to Haskell data structures.
shortly said, there are 3 ways to polymorphism:
1) C++ templates - type-specific code generated at compile time 2) OOP classes - every object carries VMT which allows to select type-specific operation 3) type classes - dictionary of type-specific operations is given as additional hidden argument to each function
Haskell uses t.c. and its abilities are dictated by this implementation. there is no simple and direct mapping between features provided by OOP and t.c.
Can you give me a summary of why it's meaningless.....both would seem to describe/construct values/objects....they may not be equivalent, but I would expect some considerable overlap.
-----Original Message----- From: Bulat Ziganshin [mailto:bulat.ziganshin@gmail.com] Sent: 02 January 2008 20:29 To: Nicholls, Mark Cc: haskell-cafe@haskell.org Subject: Re: [Haskell-cafe] Is there anyone out there who can translate C# generics into Haskell?
Hello Mark,
Wednesday, January 2, 2008, 7:40:31 PM, you wrote:
I'm trying to translate some standard C# constucts into Haskell... some
it's meaningless. read http://haskell.org/haskellwiki/OOP_vs_type_classes and especially papers mentioned in the References
-- Best regards, Bulat mailto:Bulat.Ziganshin@gmail.com

On 4 Jan 2008, at 2:00 AM, Nicholls, Mark wrote:
You may be right...but learning is not an atomic thing....wherever I start I will get strange things happening.
The best place to start learning Haskell is with the simplest type features, not the most complicated. And it's the simplest features that are most unlike OO. Yes, Haskell will be `strange'. But if you think you're `the intersection' between Haskell and OO, you'll think things are familiar, and you'll be surprised when they turn out to be different. I'd concentrate on watching out for differences --- but then I can't imagine how finding `familiar' ideas would help. jcc

Jonathan Cast
On 4 Jan 2008, at 2:00 AM, Nicholls, Mark wrote:
You may be right...but learning is not an atomic thing....wherever I start I will get strange things happening.
The best place to start learning Haskell is with the simplest type features, not the most complicated. And it's the simplest features that are most unlike OO.
Yes, Haskell will be `strange'. But if you think you're `the intersection' between Haskell and OO, you'll think things are familiar, and you'll be surprised when they turn out to be different. I'd concentrate on watching out for differences --- but then I can't imagine how finding `familiar' ideas would help.
just a sec... things like data State = State { winSize :: IORef Size , t :: IORef Int , fps :: IORef Float , showFPS :: IORef Bool , showHelp :: IORef Bool , grabMouse :: IORef Bool , mousePos :: IORef (Maybe Position) , mouseDelta :: IORef Position , viewRot :: IORef Vec3 , angle' :: IORef GLfloat , ballPos :: IORef Vec2 , ballVel :: IORef Vec2 } makeState :: IO State makeState = do size <- newIORef $ Size 0 0 t' <- newIORef 0 fps' <- newIORef 0 sfps <- newIORef False gm <- newIORef False mp <- newIORef Nothing md <- newIORef $ Position 0 0 sh <- newIORef False v <- newIORef (0, 0, 0) a <- newIORef 0 bp <- newIORef (0, 0) bv <- newIORef (0.002, 0.002) { winSize = size , t = t', fps = fps' , showFPS = sfps, showHelp = sh , grabMouse = gm, mousePos = mp, mouseDelta = md , viewRot = v, angle' = a , ballPos = bp, ballVel = bv } and keyboard state (Char 'f') Down _ _ = showFPS state $~ not modRot :: State -> View -> IO () modRot state (dx,dy,dz) = do (x, y, z) <- get $ viewRot state viewRot state $= (x + dx, y + dy, z + dz) postRedisplay Nothing come to mind. But then this has more to do with Monads than with classes. IO, in particular, and GL and GLUT, which are state machines and thus predestined for OOP. -- (c) this sig last receiving data processing entity. Inspect headers for past copyright information. All rights reserved. Unauthorised copying, hiring, renting, public performance and/or broadcasting of this signature prohibited.

On 6 Jan 2008, at 2:13 AM, Achim Schneider wrote:
Jonathan Cast
wrote: On 4 Jan 2008, at 2:00 AM, Nicholls, Mark wrote:
You may be right...but learning is not an atomic thing....wherever I start I will get strange things happening.
The best place to start learning Haskell is with the simplest type features, not the most complicated. And it's the simplest features that are most unlike OO.
Yes, Haskell will be `strange'. But if you think you're `the intersection' between Haskell and OO, you'll think things are familiar, and you'll be surprised when they turn out to be different. I'd concentrate on watching out for differences --- but then I can't imagine how finding `familiar' ideas would help.
just a sec...
things like
come to mind.
But then this has more to do with Monads than with classes. IO, in particular, and GL and GLUT, which are state machines and thus predestined for OOP.
Your example is very unintuitive and unidiomatic Haskell. The reference to GL makes me think this is for a `low-level' binding to an imperative library, no? Those are scarcely good places to learn Haskell. jcc

Jonathan Cast
On 6 Jan 2008, at 2:13 AM, Achim Schneider wrote:
Jonathan Cast
wrote: On 4 Jan 2008, at 2:00 AM, Nicholls, Mark wrote:
You may be right...but learning is not an atomic thing....wherever I start I will get strange things happening.
The best place to start learning Haskell is with the simplest type features, not the most complicated. And it's the simplest features that are most unlike OO.
Yes, Haskell will be `strange'. But if you think you're `the intersection' between Haskell and OO, you'll think things are familiar, and you'll be surprised when they turn out to be different. I'd concentrate on watching out for differences --- but then I can't imagine how finding `familiar' ideas would help.
just a sec...
things like
come to mind.
But then this has more to do with Monads than with classes. IO, in particular, and GL and GLUT, which are state machines and thus predestined for OOP.
Your example is very unintuitive and unidiomatic Haskell. The reference to GL makes me think this is for a `low-level' binding to an imperative library, no? Those are scarcely good places to learn Haskell.
Well, I learnt a lot, knowing GL quite well already and seeing how easy everything fit together and how easy it was to abstract things away, like stuffing a bunch of IO actions consisting of GL primitives into a map, automatically generating and managing display-lists... I don't speak C++, btw, just C and Java. You can't just take years of programming experience and then start again with calculating Fibonacci numbers, just this time implemented functionally... There's always this creepy feeling that you understand everything, although you didn't understand a thing. Shivers run down my spine when I think about how let amb = 0.2 ambm = 0.2 spec = 0.7 preservingMatrix $ do materialDiffuse FrontAndBack $= Color4 ambm ambm ambm 0.3 materialSpecular FrontAndBack $= Color4 spec spec spec 0.7 materialShininess FrontAndBack $= 50 border 30 40 (depth * 10) 0.01 True looks like in C. or, for that matter, what atrocious code gcc generates if you parametrise calls to vertex3f with functions. -- (c) this sig last receiving data processing entity. Inspect headers for past copyright information. All rights reserved. Unauthorised copying, hiring, renting, public performance and/or broadcasting of this signature prohibited.

Achim Schneider wrote:
things like
data State = State { winSize :: IORef Size , t :: IORef Int , fps :: IORef Float , showFPS :: IORef Bool , showHelp :: IORef Bool , grabMouse :: IORef Bool , mousePos :: IORef (Maybe Position) , mouseDelta :: IORef Position , viewRot :: IORef Vec3 , angle' :: IORef GLfloat , ballPos :: IORef Vec2 , ballVel :: IORef Vec2 }
Yuck! I'm not sure whether this is a real example or not, but if it's real, get rid of all those IORefs. Make State a simple type, and use (IORef State) as needed for callbacks, and hide that fact in other code. Jules

jules:
Achim Schneider wrote:
things like
data State = State { winSize :: IORef Size , t :: IORef Int , fps :: IORef Float , showFPS :: IORef Bool , showHelp :: IORef Bool , grabMouse :: IORef Bool , mousePos :: IORef (Maybe Position) , mouseDelta :: IORef Position , viewRot :: IORef Vec3 , angle' :: IORef GLfloat , ballPos :: IORef Vec2 , ballVel :: IORef Vec2 }
Yuck!
I'm not sure whether this is a real example or not, but if it's real, get rid of all those IORefs. Make State a simple type, and use (IORef State) as needed for callbacks, and hide that fact in other code.
I agree, this is very-unHaskelly :) The State type should be a simple purely functional structured, threaded through your code via a StateT or some such. Not a bunch of pointers in IO. See xmonad for examples of this in highly effectful programs, http://code.haskell.org/xmonad/XMonad/Core.hs newtype X a = X (ReaderT XConf (StateT XState IO) a) (Carries read-only and updatable state components) -- Don

Don Stewart
jules:
Achim Schneider wrote:
things like
data State = State { winSize :: IORef Size , t :: IORef Int , fps :: IORef Float , showFPS :: IORef Bool , showHelp :: IORef Bool , grabMouse :: IORef Bool , mousePos :: IORef (Maybe Position) , mouseDelta :: IORef Position , viewRot :: IORef Vec3 , angle' :: IORef GLfloat , ballPos :: IORef Vec2 , ballVel :: IORef Vec2 }
Yuck!
I'm not sure whether this is a real example or not, but if it's real, get rid of all those IORefs. Make State a simple type, and use (IORef State) as needed for callbacks, and hide that fact in other code.
I agree, this is very-unHaskelly :)
The State type should be a simple purely functional structured, threaded through your code via a StateT or some such. Not a bunch of pointers in IO.
See xmonad for examples of this in highly effectful programs,
http://code.haskell.org/xmonad/XMonad/Core.hs
newtype X a = X (ReaderT XConf (StateT XState IO) a)
(Carries read-only and updatable state components)
Yes, you see, that was my first Haskell program bigger than 20 lines, there's no possibility to get the state out of the IO Monad, at least without writing a high-level interface to glut and gl, and then there's this thing that _every_ game works with input callbacks, one, global, state update function (where it doesn't _really_ matter whether you're passing and returning a state or updating a state) and one function that translates the state into some graphics representation. That said, I think it's not very Haskell-like to do something elegantly in 1000 lines when you can do it in 100 lines and still have it look nicer than C. If the update function of this particular one ever gets more complicated than idle :: State -> IdleCallback idle state = do t0 <- get $ t state t1 <- get elapsedTime t state $= t1 let td = fromIntegral t1 - fromIntegral t0 fps state $= 1/td * 1000 (bpx, bpy) <- get $ ballPos state (bvx, bvy) <- get $ ballVel state ballPos state $= (bpx + bvx*td, bpy + bvy*td) postRedisplay Nothing , I'll think of something. -- (c) this sig last receiving data processing entity. Inspect headers for past copyright information. All rights reserved. Unauthorised copying, hiring, renting, public performance and/or broadcasting of this signature prohibited.

On Tue, Jan 08, 2008 at 09:10:59PM +0100, Achim Schneider wrote:
Don Stewart
wrote: jules:
Achim Schneider wrote:
things like
data State = State { winSize :: IORef Size , t :: IORef Int , fps :: IORef Float , showFPS :: IORef Bool , showHelp :: IORef Bool , grabMouse :: IORef Bool , mousePos :: IORef (Maybe Position) , mouseDelta :: IORef Position , viewRot :: IORef Vec3 , angle' :: IORef GLfloat , ballPos :: IORef Vec2 , ballVel :: IORef Vec2 }
Yuck!
I'm not sure whether this is a real example or not, but if it's real, get rid of all those IORefs. Make State a simple type, and use (IORef State) as needed for callbacks, and hide that fact in other code.
I agree, this is very-unHaskelly :)
The State type should be a simple purely functional structured, threaded through your code via a StateT or some such. Not a bunch of pointers in IO.
See xmonad for examples of this in highly effectful programs,
http://code.haskell.org/xmonad/XMonad/Core.hs
newtype X a = X (ReaderT XConf (StateT XState IO) a)
(Carries read-only and updatable state components)
Yes, you see, that was my first Haskell program bigger than 20 lines, there's no possibility to get the state out of the IO Monad, at least without writing a high-level interface to glut and gl, and then there's this thing that _every_ game works with input callbacks, one, global, state update function (where it doesn't _really_ matter whether you're passing and returning a state or updating a state) and one function that translates the state into some graphics representation.
That said, I think it's not very Haskell-like to do something elegantly in 1000 lines when you can do it in 100 lines and still have it look nicer than C.
I would use IORef State. Making illegal states unrepresentable greatly helps with code prettiness; the original State allowed internal aliasing, which is quite definitely silly. I think this should be written somewhere as a general rule - when you have a mutable structure, use a reference to a record, not a record of references. Stefan

Stefan O'Rear
On Tue, Jan 08, 2008 at 09:10:59PM +0100, Achim Schneider wrote:
That said, I think it's not very Haskell-like to do something elegantly in 1000 lines when you can do it in 100 lines and still have it look nicer than C.
I would use IORef State. Making illegal states unrepresentable greatly helps with code prettiness; the original State allowed internal aliasing, which is quite definitely silly.
I think this should be written somewhere as a general rule - when you have a mutable structure, use a reference to a record, not a record of references.
So it would be, instead of ---$<--- idle :: State -> IdleCallback idle state = do (bpx, bpy) <- get $ ballPos state (bvx, bvy) <- get $ ballVel state ballPos state $= (bpx + bvx*td, bpy + bvy*td) ---$<--- type StateRef = IORef State' idle' :: StateRef -> IdleCallback idle' st = do state <- get st let (bpx, bpy) = ballPos' state (bvx, bvy) = ballVel' state st $= state {ballPos' = (bpx+bvx, bpy+bvy)} ---$<--- or, while I'm at it ---$<--- moveBall :: State' -> State' moveBall state = state {ballPos' = (bpx+bvx, bpy+bvy)} where (bpx, bpy) = ballPos' state (bvx, bvy) = ballVel' state idle'' :: StateRef -> IdleCallback idle'' st = st $~ moveBall ---$<--- With the multiple IORef-Model, moveBall looks like this: moveBall :: Vec2 -> Vec2 -> Vec2 moveBall (bpx, bpy) (bvx,bvy) = (bpx+bvx, bpy+bvy) which is IMHO pure Haskell. On the other hand, with the one IORef-Model, the draw function could not possibly mangle any state, which would be a good thing, doing such things can result in keyboards being smashed over heads by team colleagues. I'll think about it and then let you know how to properly tackle the awkward GLpong squad. Generally, in game programming you can have so many state-related bugs that it's infeasible to detect them all statically. You also cheat much, doing stage magic instead of the real stuff, and trading off things all the time. -- (c) this sig last receiving data processing entity. Inspect headers for past copyright information. All rights reserved. Unauthorised copying, hiring, renting, public performance and/or broadcasting of this signature prohibited.

On 8 Jan 2008, at 3:38 PM, Achim Schneider wrote:
---$<--- or, while I'm at it ---$<---
moveBall :: State' -> State' moveBall state = state {ballPos' = (bpx+bvx, bpy+bvy)} where (bpx, bpy) = ballPos' state (bvx, bvy) = ballVel' state
idle'' :: StateRef -> IdleCallback idle'' st = st $~ moveBall
---$<---
With the multiple IORef-Model, moveBall looks like this:
moveBall :: Vec2 -> Vec2 -> Vec2 moveBall (bpx, bpy) (bvx,bvy) = (bpx+bvx, bpy+bvy)
You can use this with the single IORef model, using the lifting function liftMove :: (Vec2 -> Vec2 -> Vec2) -> IORef State -> IO () liftMove move r = withIORef r $ \ st -> st{ballPos = moveBall (ballPos st) (ballVel st) } liftMove and moveBall can then be maintained separately; liftMove is part of your state framework (the outer layer of your program); moveBall is part of the algorithm specification (the inner layer of your program). jcc

Achim Schneider wrote:
Yes, you see, that was my first Haskell program bigger than 20 lines, there's no possibility to get the state out of the IO Monad, at least without writing a high-level interface to glut and gl, and then there's this thing that _every_ game works with input callbacks, one, global, state update function (where it doesn't _really_ matter whether you're passing and returning a state or updating a state) and one function that translates the state into some graphics representation.
Understood. My objection was not about having an IORef somewhere (you need it to thread via the callback), but about making each component an IORef when one big IORef makes more sense. It makes plenty of sense to try to write precise type signatures, including not having IO in the type of functions which don't do IO. For ramblings about the annoyance of having to use IORefs to thread your custom monad state through callbacks, take a look at http://www.haskell.org/pipermail/haskell-cafe/2007-July/028501.html which sketches a typeclass "solution" Jules

On Wed, 2008-01-02 at 15:49 +0200, Yitzchak Gale wrote: [...]
Some people are worried that this version of Hask is missing certain nice properties that one would like to have. For example, it was recently claimed on this list that tuples are not products in that category. (Or some such. I would be interested to see a demonstration of that.)
Johnathan has given such a demonstration (and it has been demonstrated many times on this list since it's creation, it's well-known).
I am not impressed by those complaints. As usual in category theory, you define corresponding notions in Hask, and prove that they are preserved under the appropriate functors. That should always be easy. And if ever it is not, then you have discovered an interesting non-trivial consequence of laziness that deserves study.
You are right not to be impressed by such complaints, but you misrepresent people's views on this by saying that the "worry" about such problems. As you say (people say), these properties [that Hask is cartesian closed to start] would be nice to have and are very convenient to assume which is often safe enough. Certainly computer scientists of a categorical bent have developed (weaker) notions to use; namely, monoidal, pre-monoidal, Freyd, and/or kappa categories and no doubt others. Using these, however, removes some of the allure of using a categorical approach. Also, there is a Haskell-specific problem at the very get-go. The most "obvious" choice for the categorical composition operator assuming the "obvious" choice for the arrows and objects does not work, it does not satisfy the laws of a category assuming the = used in them is observational equality. Namely, id . f /= f /= f . id for all functions f, in particular, it fails when f = undefined. This can easily be fixed by making the categorical (.) strict in both arguments and there is no formal problem with it being different from Haskell's (.), but it certainly is not intuitively appealing.

I wrote:
...it was recently claimed on this list that tuples are not products in that category.
Derek Elkins wrote:
Johnathan has given such a demonstration (and it has been demonstrated many times on this list since it's creation, it's well-known).
We're still working on it. I've not been convinced yet. Sorry about my thickness. Perhaps this should be on a nice wiki page somewhere. I tried to convince David House to put it in the Wikibook chapter, but he is right, that needs to simpler. There is some discussion on the talk page for that chapter, but no one spells out the details there, either.
You are right not to be impressed by such complaints, but you misrepresent people's views on this by saying that they "worry" about such problems.
Sorry, I hope I am not misrepresenting anyone. I just notice that people make assumptions about a so-called category Hask, derive various conclusions, then mention that they are not really true. Perhaps it is only me who is worried.
As you say (people say), these properties [that Hask is cartesian closed to start] would be nice to have and are very convenient to assume which is often safe enough.
I'd like to understand better what is true, so that I can understand what is safe.
Certainly computer scientists of a categorical bent have developed (weaker) notions to use; namely, monoidal, pre-monoidal, Freyd, and/or kappa categories and no doubt others. Using these, however, removes some of the allure of using a categorical approach.
It would be nice to distill out of that the basics that are needed to get the properties that we need for day-to-day work in Haskell.
Also, there is a Haskell-specific problem at the very get-go. The most "obvious" choice for the categorical composition operator assuming the "obvious" choice for the arrows and objects does not work... ...This can easily be fixed by making the categorical (.) strict in both arguments and there is no formal problem with it being different from Haskell's (.), but it certainly is not intuitively appealing.
I'm not sure it's so bad. First of all, not only is it not a formal problem, it's also not really a practical problem - there will rarely if ever be any difference between the two when applied in real programs. My opinion is that there would not be any problem with using that version as (.) in the Prelude. Even if we never do, at least we should then use (.!) when we state the so-called "Monad laws". It bothers me that Haskell's so-called "monads" really aren't. That is bound to cause problems. And it would be so easy to fix in most cases - just require monad bind to be strict on the second parameter. Thanks, Yitz

Yitzchak Gale wrote:
I wrote:
...it was recently claimed on this list that tuples are not products in that category.
I've not been convinced yet.
I'm going to try convince you :) The crucial problem of Haskell's product is that (_|_,_|_) ≠ _|_ but that the two projections fst :: (A,B) -> A snd :: (A,B) -> B cannot distinguish between both values. But if (,) were a categorial product, fst and snd would completely determine it. We would have the universal property that for every f :: C -> A g :: C -> B there is a _unique_ morphism f &&& g :: C -> (A,B) subject to f = fst . (f &&& g) g = snd . (f &&& g) In other words, there is a unique function (&&&) :: forall c . (c -> A) -> (c -> B) -> (c -> (A,B)) f &&& g = \c -> (f c, g c) In the particular case of C=(A,B), f=fst and g=snd , the identity function is such a morphism which means fst &&& snd = id due to uniqueness. But id _|_ ≠ id (_|_,_|_) while clearly (fst &&& snd) _|_ = (fst &&& snd) (_|_,_|_)
Derek Elkins wrote:
Also, there is a Haskell-specific problem at the very get-go. The most "obvious" choice for the categorical composition operator assuming the "obvious" choice for the arrows and objects does not work... ...This can easily be fixed by making the categorical (.) strict in both arguments and there is no formal problem with it being different from Haskell's (.), but it certainly is not intuitively appealing.
Note that the problem with (.) is "seq's fault" (pun intended :) Otherwise, it would be impossible to distinguish _|_ from its eta-expansion \x._|_ . Regards, apfelmus
participants (11)
-
Achim Schneider
-
apfelmus
-
Bulat Ziganshin
-
Derek Elkins
-
Don Stewart
-
Jonathan Cast
-
Jules Bean
-
Nicholls, Mark
-
Ryan Ingram
-
Stefan O'Rear
-
Yitzchak Gale