Re: [Haskell] Mixing monadic and non-monadic functions

2005-09-17 Thread Thomas Jäger
Hello, I haven't followed this discussion very closely, but in case you want to play with this sort of thing, you can check out the code from my TMR-Article http://www.haskell.org/tmrwiki/FunWithLinearImplicitParameters Despite the wacky implementation it is actually surprisingly reliable, modulo

Re: [Haskell] Mixing monadic and non-monadic functions

2005-09-17 Thread Ben Rudiak-Gould
Frederik Eaton wrote: I think this is a good idea. I like the inline "<-", or maybe something like "@". The operator-section notation (<- expr) has the big advantage of being unlikely to collide with any other syntax proposals. I'm not sure what you intend to do about nested "do" statements

Re: [Haskell] Mixing monadic and non-monadic functions

2005-09-17 Thread Ben Rudiak-Gould
Bjorn Lisper wrote: However, there is a way to resolve the ambiguity that can be claimed to be the most natural one, and that is to always choose the "least possible" lifting. In the example above, this would mean to interpret [[1]]++[[2]] precisely as [[1]]++[[2]] (lift 0 levels) rather than [[1

Re: [Haskell] Mixing monadic and non-monadic functions

2005-09-16 Thread Wolfgang Jeltsch
Am Freitag, 16. September 2005 14:02 schrieb Sergey Zaharchenko: > [...] > > do x <- newIORef 0 > >y <- newIORef 0 > >z <- newIORef 0 > >z := *x + *y -- translated to { x' <- readIORef x; y' <- readIORef > > y; writeIORef z (x'+y') } > > I might be misunderstanding, but aren't we goi

Re: [Haskell] Mixing monadic and non-monadic functions

2005-09-16 Thread Sergey Zaharchenko
Hello Bulat! Thu, Sep 15, 2005 at 09:19:41PM +0400 you wrote: > Hello Ben, > > Wednesday, September 14, 2005, 6:32:27 PM, you wrote: > > BRG> do { ... ; ... borrow E ... ; ... } > > BRG> is transformed into > > BRG> do { ... ; x <- E ; ... x ... ; ... } > > i strongly support this

Re: [Haskell] Mixing monadic and non-monadic functions

2005-09-15 Thread Frederik Eaton
> I have another proposal, though. Introduce a new keyword, which I'll > call "borrow" (the opposite of "return"), that behaves like a > function of type (Monad m) => m a -> a inside of do statements. More > precisely, a do expression of the form > > do { ... ; ... borrow E ... ; ... } > > i

Re: [Haskell] Mixing monadic and non-monadic functions

2005-09-15 Thread Einar Karttunen
On 15.09 23:40, Bulat Ziganshin wrote: > of course > > class Ref c a where > new :: a -> IO (c a) > get :: c a -> IO a > set :: c a -> a -> IO () Maybe even: class Ref m t where new :: a -> m (t a) get :: t a -> m a set :: t a -> a -> m () Or if you want to support things like FastM

Re: [Haskell] Mixing monadic and non-monadic functions

2005-09-15 Thread robert dockins
I raise you: class (Monad m) => Ref m c | c -> m where new :: a -> m (c a) get :: c a -> m a peek :: c a -> m a set :: c a -> a -> m () modify :: c a -> (a -> a) -> m a modify_ :: c a -> (a -> a) -> m () modifyM :: c a -> (a -> m a) -> m a

Re: [Haskell] Mixing monadic and non-monadic functions

2005-09-15 Thread Lyle Kopnicky
Bulat Ziganshin wrote: Hello Ben, Wednesday, September 14, 2005, 6:32:27 PM, you wrote: BRG> do { ... ; ... borrow E ... ; ... } BRG> is transformed into BRG> do { ... ; x <- E ; ... x ... ; ... } i strongly support this suggestion. actually, i suggest the same for dealing with re

Re: [Haskell] Mixing monadic and non-monadic functions

2005-09-14 Thread Bjorn Lisper
Ben Rudiak-Gould: >Frederik Eaton wrote: >> I want the type system to be able to do "automatic lifting" of monads, >> i.e., since [] is a monad, I should be able to write the following: >> >> [1,2]+[3,4] >> >> and have it interpreted as "do {a<-[1,2]; b<-[3,4]; return (a+b)}". > >The main problem

Re: [Haskell] Mixing monadic and non-monadic functions

2005-09-14 Thread Ben Rudiak-Gould
Frederik Eaton wrote: I want the type system to be able to do "automatic lifting" of monads, i.e., since [] is a monad, I should be able to write the following: [1,2]+[3,4] and have it interpreted as "do {a<-[1,2]; b<-[3,4]; return (a+b)}". The main problem is ambiguity: [[1]]++[[2]] could be

Re: [Haskell] Mixing monadic and non-monadic functions

2005-09-09 Thread Frederik Eaton
Anyway, if the idea is to ultimately wrap every value in an expression like ([1,2]+[3,4]) in a 'run' application, that doesn't sound very useful. Program structure might be improved, but it would be bloated out by these calls. Also, I don't know what would happen to the readability of type checker

Re: [Haskell] Mixing monadic and non-monadic functions

2005-09-09 Thread Frederik Eaton
On Thu, Sep 08, 2005 at 09:34:33AM +0100, Keean Schupke wrote: > Can't you do automatic lifting with a "Runnable" class: > > class Runnable x y where >run :: x -> y > > instance Runnable (m a) (m a) where > run = id > > instance Runnable (s -> m a) (s -> m a) where >

Re: [Haskell] Mixing monadic and non-monadic functions

2005-09-09 Thread J. Garrett Morris
On 9/9/05, Keean Schupke <[EMAIL PROTECTED]> wrote: > Just noticed the 1+[1,2] case... I am not certain whether this is > possible - it is outside the > scope of the formal definiton of Haskell and may rely on implementation > details of the compiler/interpreter. While this is outside the scope o

Re: [Haskell] Mixing monadic and non-monadic functions

2005-09-09 Thread Keean Schupke
Keean Schupke wrote: I'm not sure exactly what you have in mind. Obviously I want something that applies to all functions, with any number of arguments, and not just (+). Furthermore, it should handle cases like 1+[2,3] where only one value is monadic. Just noticed the 1+[1,2] case... I am no

Re: [Haskell] Mixing monadic and non-monadic functions

2005-09-09 Thread Keean Schupke
Malcolm Wallace wrote: Wolfgang Jeltsch <[EMAIL PROTECTED]> writes: I'm not sure exactly what you have in mind. Obviously I want something that applies to all functions, with any number of arguments, and not just (+). Furthermore, it should handle cases like 1+[2,3] where only one value is

Re: [Haskell] Mixing monadic and non-monadic functions

2005-09-09 Thread Malcolm Wallace
Wolfgang Jeltsch <[EMAIL PROTECTED]> writes: > > I'm not sure exactly what you have in mind. Obviously I want something > > that applies to all functions, with any number of arguments, and not > > just (+). Furthermore, it should handle cases like 1+[2,3] where only > > one value is monadic. > >

Re: [Haskell] Mixing monadic and non-monadic functions

2005-09-09 Thread Wolfgang Jeltsch
Am Donnerstag, 8. September 2005 22:30 schrieb Frederik Eaton: > Hi Chad, > > I'm not sure exactly what you have in mind. Obviously I want something > that applies to all functions, with any number of arguments, and not > just (+). Furthermore, it should handle cases like 1+[2,3] where only > one v

Re: [Haskell] Mixing monadic and non-monadic functions

2005-09-08 Thread John Meacham
On Thu, Sep 08, 2005 at 01:30:51PM -0700, Frederik Eaton wrote: > On Thu, Sep 08, 2005 at 09:30:34AM -0700, Scherrer, Chad wrote: > > One of Mark Jones's articles suggests something like > > > > class Plus a b c | a b -> c where > > (+) :: a -> b -> c > > > > Would > > > > instance (Plus a b c

Re: [Haskell] Mixing monadic and non-monadic functions

2005-09-08 Thread Frederik Eaton
On Thu, Sep 08, 2005 at 09:30:34AM -0700, Scherrer, Chad wrote: > One of Mark Jones's articles suggests something like > > class Plus a b c | a b -> c where > (+) :: a -> b -> c > > Would > > instance (Plus a b c, Monad m) => Plus (m a) (m b) (m c) where > mx + my = do x <- mx >

Re: [Haskell] Mixing monadic and non-monadic functions

2005-09-08 Thread Scherrer, Chad
One of Mark Jones's articles suggests something like class Plus a b c | a b -> c where (+) :: a -> b -> c Would instance (Plus a b c, Monad m) => Plus (m a) (m b) (m c) where mx + my = do x <- mx y <- my return (x + y) do what you're looking for? Chad Scherrer

Re: [Haskell] Mixing monadic and non-monadic functions

2005-09-08 Thread Frederik Eaton
On Thu, Sep 08, 2005 at 10:35:49AM +0200, Wolfgang Lux wrote: > Frederik Eaton wrote: > > >I want the type system to be able to do "automatic lifting" of monads, > >i.e., since [] is a monad, I should be able to write the following: > >and have it interpreted as "do {a<-[1,2]; b<-[3,4]; return (a+

Re: [Haskell] Mixing monadic and non-monadic functions

2005-09-08 Thread Wolfgang Lux
Frederik Eaton wrote: I want the type system to be able to do "automatic lifting" of monads, i.e., since [] is a monad, I should be able to write the following: and have it interpreted as "do {a<-[1,2]; b<-[3,4]; return (a+b)}". Are you sure that this is the interpretation you have in mind?

Re: [Haskell] Mixing monadic and non-monadic functions

2005-09-08 Thread Keean Schupke
Can't you do automatic lifting with a "Runnable" class: class Runnable x y where run :: x -> y instance Runnable (m a) (m a) where run = id instance Runnable (s -> m a) (s -> m a) where run = id instance (Monad m,Monad n,MonadT t m,Runnable (m a) (n a)) => Run

Re: [Haskell] Mixing monadic and non-monadic functions

2005-09-08 Thread Jeremy Gibbons
On Wed, 7 Sep 2005, Frederik Eaton wrote: > I want the type system to be able to do "automatic lifting" of monads, > i.e., since [] is a monad, I should be able to write the following: > > [1,2]+[3,4] > > and have it interpreted as "do {a<-[1,2]; b<-[3,4]; return (a+b)}". You might want to take a

Re: [Haskell] Mixing monadic and non-monadic functions

2005-09-08 Thread Frederik Eaton
I guess what I don't understand is what's wrong with the first alternative you mention: > One way of preventing the compiler from rearranging effects is to > thread though a dummy variable - like a "World token", ala the IO > monad - which makes the order of operations explicit as an extra > data

Re: [Haskell] Mixing monadic and non-monadic functions

2005-09-07 Thread Frederik Eaton
> Frederik, > To do "automatic lifting" you need to do a (higher-order) effect analysis, > then make sure the > compiler doesn't rearrange applications which have conflicting effects. Hrm, I disagree. I don't think this is what I was advocating in my message. What I'm advocating is a reasonably

Re: [Haskell] Mixing monadic and non-monadic functions

2005-09-07 Thread Ben Lippmeier
Frederik Eaton wrote: I want the type system to be able to do "automatic lifting" of monads, i.e., since [] is a monad, I should be able to write the following: [1,2]+[3,4] and have it interpreted as "do {a<-[1,2]; b<-[3,4]; return (a+b)}". print ("a: " ++ readLn ++ "\nb: " ++ readLn) two

Re: [Haskell] Mixing monadic and non-monadic functions

2005-09-07 Thread Frederik Eaton
Hi, Sean's comment (yeah, it was like a billion years ago, just catching up) is something that I've often thought myself. I want the type system to be able to do "automatic lifting" of monads, i.e., since [] is a monad, I should be able to write the following: [1,2]+[3,4] and have it interpret

Re: [Haskell] Mixing monadic and non-monadic functions

2004-03-24 Thread Glynn Clements
[EMAIL PROTECTED] wrote: > >> We'd all love to make the lifting implicit, but no one knows how to > >> do it > >> without breaking the whole language. > > > > I've heard people talk about the functional "purity" of Haskell -- > > you'd have > > to break this purity to add implicit lifting? > >

Re: [Haskell] Mixing monadic and non-monadic functions

2004-03-23 Thread Max Kirillov
On Tue, Mar 23, 2004 at 10:29:26AM -0500, Sean E. Russell wrote: > Here's my base case: > > someFunc :: String -> IO [a] > ... > ax <- someFunc a > bx <- someFunc b > assertBool "fail" $ length ax == length bx > > <...>What I'd much rather have

Re: [Haskell] Mixing monadic and non-monadic functions

2004-03-23 Thread ozone
On 24/03/2004, at 9:54 AM, Sean E. Russell wrote: We'd all love to make the lifting implicit, but no one knows how to do it without breaking the whole language. I've heard people talk about the functional "purity" of Haskell -- you'd have to break this purity to add implicit lifting? I don't thi

Re: [Haskell] Mixing monadic and non-monadic functions

2004-03-23 Thread Duncan Coutts
On Tue, 2004-03-23 at 15:29, Sean E. Russell wrote: > Here's my base case: > > someFunc :: String -> IO [a] > ... > ax <- someFunc a > bx <- someFunc b > assertBool "fail" $ length ax == length bx > > I don't like the assignments; the typing

Re: [Haskell] Mixing monadic and non-monadic functions

2004-03-23 Thread Sean E. Russell
On Tuesday 23 March 2004 17:04, you wrote: > * Memory management (allocation and deallocation) is effortless. > > * Creating lexical closures is very easy. > > * You don't have to declare the types of all your functions and local > bindings, because the implementation can figure them out

Re: [Haskell] Mixing monadic and non-monadic functions

2004-03-23 Thread Ben Rudiak-Gould
On Tue, 23 Mar 2004, Sean E. Russell wrote: > The standard explaination about why monads are so troublesome always sounds > like an excuse to me. We have monads, because they allow side-effects. Ok. > If programs that used side effects were uncommon, I'd be fine with them being > troublesome

Re: [Haskell] Mixing monadic and non-monadic functions

2004-03-23 Thread Graham Klyne
At 12:55 23/03/04 -0500, Sean E. Russell wrote: On Tuesday 23 March 2004 11:36, Graham Klyne wrote: > I think you're a rather stuck with the "temporary variables" (which they'= re > not really), but it might be possible to hide some of the untidiness in an > auxiliary monadic function. That seems t

Re: [Haskell] Mixing monadic and non-monadic functions

2004-03-23 Thread Iavor S. Diatchki
hi, at some level you are right that some more syntactic sugar and stuff could make monads more atracitve. for the time being here is how i'd write what you want bellow: f # m = liftM f m mx === my = liftM2 (==) m1 m2 assertBool "fail" $ (length # someFunc a) === (length # someFunc b) a

Re: [Haskell] Mixing monadic and non-monadic functions

2004-03-23 Thread Sean E. Russell
On Tuesday 23 March 2004 11:36, Graham Klyne wrote: > I think you're a rather stuck with the "temporary variables" (which they're > not really), but it might be possible to hide some of the untidiness in an > auxiliary monadic function. That seems to be the common suggestion: write my own visitors

Re: [Haskell] Mixing monadic and non-monadic functions

2004-03-23 Thread Graham Klyne
I think you're a rather stuck with the "temporary variables" (which they're not really), but it might be possible to hide some of the untidiness in an auxiliary monadic function. Assuming this function is given: assertBool :: String -> Bool -> IO () ... My first stab would be: assertBool1 ::