[Haskell-cafe] Re: [Haskell] Top Level -

2008-09-03 Thread Ashley Yakeley

Ganesh Sittampalam wrote:
In any case, what I'm trying to establish below is that it should be a 
safety property of - that the entire module (or perhaps mutually 
recursive groups of them?) can be duplicated safely - with a new name, 
or as if with a new name - and references to it randomly rewritten to 
the duplicate, as long as the result still type checks.


That's not acceptable. This would cause Unique to break, as its MVar 
would be created twice. It would also mean that individual Unique and 
IOWitness values created by - would have different values depending on 
which bit of code was referencing them. It would render the extension 
useless as far as I can see.


It also introduces odd execution scopes again. In order for - to work, 
it must be understood that a given - initialiser in a given module in a 
given version of a given package will execute at most once per RTS. But 
your restriction breaks that.


It's worth mentioning that the current Data.Unique is part of the 
standard base library, while hs-plugins is rather experimental. 
Currently Data.Unique uses the NOINLINE unsafePerformIO hack to create 
its MVar. If hs-plugins duplicates that MVar, that's a bug in 
hs-plugins. It's up to a dynamic loader to get initialisation code correct.


--
Ashley Yakeley
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


RE: [Haskell-cafe] Re: [Haskell] Top Level -

2008-09-03 Thread Sittampalam, Ganesh
Ashley Yakeley wrote: 

Ganesh Sittampalam wrote:
 In any case, what I'm trying to establish below is that it should be
a 
 safety property of - that the entire module (or perhaps mutually 
 recursive groups of them?) can be duplicated safely - with a new
name, 
 or as if with a new name - and references to it randomly rewritten to

 the duplicate, as long as the result still type checks.

 That's not acceptable. This would cause Unique to break, 
 as its MVar would be created twice. It would also mean 
 that individual Unique and IOWitness values created by
 - would have different values depending on which bit 
 of code was referencing them. It would render the extension
 useless as far as I can see.

The result wouldn't typecheck if two Unique values that now pointed to
the two different modules were compared.

Ganesh

==
Please access the attached hyperlink for an important electronic communications 
disclaimer: 

http://www.credit-suisse.com/legal/en/disclaimer_email_ib.html
==

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: [Haskell] Top Level -

2008-09-03 Thread Ashley Yakeley

David Menendez wrote:

Isn't that what we have right now? Typeable gives you a TypeRep, which
can be compared for equality. All the introspection stuff is in Data.


Oh, yes, you're right.

--
Ashley Yakeley

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: [Haskell] Top Level -

2008-09-03 Thread David Menendez
On Wed, Sep 3, 2008 at 2:53 AM, Ashley Yakeley [EMAIL PROTECTED] wrote:

 It's worth mentioning that the current Data.Unique is part of the standard
 base library, while hs-plugins is rather experimental. Currently Data.Unique
 uses the NOINLINE unsafePerformIO hack to create its MVar. If hs-plugins
 duplicates that MVar, that's a bug in hs-plugins. It's up to a dynamic
 loader to get initialisation code correct.

Data.Unique describes itself as experimental and non-portable. The
Haskell 98 report includes NOINLINE, but also states that environments
are not required to respect it. So hs-plugins wouldn't necessarily be
at fault if it didn't support Data.Unique.

-- 
Dave Menendez [EMAIL PROTECTED]
http://www.eyrie.org/~zednenem/
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


RE: [Haskell-cafe] Re: [Haskell] Top Level -

2008-09-03 Thread Sittampalam, Ganesh
Dave Menendez wrote: 

 The Haskell 98 report includes NOINLINE, but 
 also states that environments are not required
 to respect it. So hs-plugins wouldn't necessarily
 be at fault if it didn't support Data.Unique.

Also, the definition of NOINLINE in the report doesn't
preclude copying both the MVar *and* its use sites,
which is what I am proposing should be considered
generally safe.

Ganesh

==
Please access the attached hyperlink for an important electronic communications 
disclaimer: 

http://www.credit-suisse.com/legal/en/disclaimer_email_ib.html
==

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: [Haskell] Top Level -

2008-09-03 Thread Ashley Yakeley

Sittampalam, Ganesh wrote:
That's not acceptable. This would cause Unique to break, 
as its MVar would be created twice. It would also mean 
that individual Unique and IOWitness values created by
- would have different values depending on which bit 
of code was referencing them. It would render the extension

useless as far as I can see.


The result wouldn't typecheck if two Unique values that now pointed to
the two different modules were compared.


I don't understand. If the dynamic loader were to load the same package 
name and version, and it duplicated the MVar, then Unique values would 
have the same type and could be compared.


--
Ashley Yakeley
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: [Haskell] Top Level -

2008-09-03 Thread Ashley Yakeley

David Menendez wrote:

On Wed, Sep 3, 2008 at 2:53 AM, Ashley Yakeley [EMAIL PROTECTED] wrote:

It's worth mentioning that the current Data.Unique is part of the standard
base library, while hs-plugins is rather experimental. Currently Data.Unique
uses the NOINLINE unsafePerformIO hack to create its MVar. If hs-plugins
duplicates that MVar, that's a bug in hs-plugins. It's up to a dynamic
loader to get initialisation code correct.


Data.Unique describes itself as experimental and non-portable. The
Haskell 98 report includes NOINLINE, but also states that environments
are not required to respect it. So hs-plugins wouldn't necessarily be
at fault if it didn't support Data.Unique.


I found this:

To solve this the hs-plugins dynamic loader maintains state storing a 
list of what modules and packages have been loaded already. If load is 
called on a module that is already loaded, or dependencies are attempted 
to load, that have already been loaded, the dynamic loader ignores these 
extra dependencies. This makes it quite easy to write an application 
that will allows an arbitrary number of plugins to be loaded.

http://www.cse.unsw.edu.au/~dons/hs-plugins/hs-plugins-Z-H-6.html

--
Ashley Yakeley
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] RE: [Haskell] Top Level -

2008-09-03 Thread Sittampalam, Ganesh
Ashley Yakeley wrote:

 I don't understand. If the dynamic loader were to load the same
package
 name and version, and it duplicated the MVar, then Unique values would
 have the same type and could be compared.

I am suggesting that this duplication process, whether conducted by the
dynamic loader or something else, should behave as if they did not have
the
same package name or version.

This is certainly a valid transformation for Data.Unique, I am simply
saying that it should be a valid transformation on any module.

Ganesh

==
Please access the attached hyperlink for an important electronic communications 
disclaimer: 

http://www.credit-suisse.com/legal/en/disclaimer_email_ib.html
==

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


RE: [Haskell-cafe] Re: [Haskell] Top Level -

2008-09-03 Thread Sittampalam, Ganesh
Ashley Yakeley wrote:

 To solve this the hs-plugins dynamic loader maintains
 state storing a list of what modules and packages have
 been loaded already. If load is called on a module that
 is already loaded, or dependencies are attempted to load,
 that have already been loaded, the dynamic loader ignores
 these extra dependencies. This makes it quite easy to 
 write an application that will allows an arbitrary number
 of plugins to be loaded.
 http://www.cse.unsw.edu.au/~dons/hs-plugins/hs-plugins-Z-H-6.html

My recollection from using it a while ago is that if a
module is used in the main program it will still be
loaded once more in the plugin loader. This is because
the plugin loader is basically an embedded copy of ghci
without much knowledge of the host program's RTS.

Cheers,

Ganesh

==
Please access the attached hyperlink for an important electronic communications 
disclaimer: 

http://www.credit-suisse.com/legal/en/disclaimer_email_ib.html
==

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: [Haskell] Top Level -

2008-09-03 Thread Ashley Yakeley

Sittampalam, Ganesh wrote:

I am suggesting that this duplication process, whether conducted by the
dynamic loader or something else, should behave as if they did not have
the same package name or version.

This is certainly a valid transformation for Data.Unique, I am simply
saying that it should be a valid transformation on any module.


So if I dynamically load module M that uses base, I will in fact get a 
completely new and incompatible version of Maybe, IO, [], Bool, Char 
etc. in all the type-signatures of M?


--
Ashley Yakeley
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] What monad am I in?

2008-09-03 Thread Yitzchak Gale
Henry Laxen wrote:
 Have I, like Monsier Jourdain, been running in the IO monad all my
 life, and didn't even know it?

Marc Weber wrote:
 Sure...
 But the ghci error message is another one:
 Try this:
 :set -XNoMonomorphismRestriction

And I highly recommend putting that line in your .ghci file.

There is controversy about whether MR is helpful in general.
It is on by default, so I just leave it that way, and it seems
to be fine.

But at the GHCi prompt, MR is definitely a nuisance.
Get rid of it there by using :set in your .ghci file.

Regards,
Yitz
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] RE: [Haskell] Top Level -

2008-09-03 Thread Sittampalam, Ganesh
Ashley Yakeley wrote:

 Sittampalam, Ganesh wrote:
  I am suggesting that this duplication process, whether conducted by 
  the dynamic loader or something else, should behave as if they did
not 
  have the same package name or version.
 
  This is certainly a valid transformation for Data.Unique, I am
simply 
  saying that it should be a valid transformation on any module.

 So if I dynamically load module M that uses base, I will in fact
 get a completely new and incompatible version of Maybe, IO, [], 
 Bool, Char etc. in all the type-signatures of M?

I think it treats them as compatible, using the fact that 
Data.Typeable returns the same type reps (which was why I initially
mentioned Data.Typeable in this thread). This is fine for normal
modules. There's a bit of description in the Dynamic Typing section of
http://www.cse.unsw.edu.au/~dons/hs-plugins/hs-plugins-Z-H-5.html#node_s
ec_9

It's clearly the wrong thing to do for Data.Unique and any anything
else that might use -; but if there are no such types in the interface
of the plugin, then it won't matter. I can't see how to make it
safe to pass Data.Unique etc across a plugin interface without
severely restricting the possible implementation strategies for
a plugin library and its host.

Ganesh

==
Please access the attached hyperlink for an important electronic communications 
disclaimer: 

http://www.credit-suisse.com/legal/en/disclaimer_email_ib.html
==

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [haskell-cafe] Monad and kinds

2008-09-03 Thread Yitzchak Gale
Ramin wrote:
 ...no matter how many tutorials I read, I find the only
 kind of monad I can write is the monad that I copied
 and pasted from the tutorial...
 I am writing a mini-database...
 The query itself is stateful...
 The query may also make updates to the records.
 I also
 thought of trying to re-write my query algorithm to somehow use
 Control.Monad.State.Strict instead of my own query type, but then I
 wouldn't get to write my own monad!

Just Control.Monad.State should work fine.

Daniel Fischer wrote:
 But this looks very much like an application well suited for the State monad
 (or a StateT). So why not use that?

I agree with Daniel.

If you want to learn about the deeper theory of the inner
workings of monads, that's great - go ahead, and have fun!

But to solve your problem in practice, you don't need that level of
knowledge. All you need to know about is get, put, modify,
and liftIO. The StateT monad is really simple to use.

In general, practical software is higher quality when it uses
existing standard libraries. There is no more reason to re-invent
the StateT monad than there is to re-invent anything else
in the libraries.

Among the multitude of monad tutorials out there, I wonder how
many of them draw a clear line between what you need to
understand to design monads, and what you need to understand
just to use them. There's a huge difference in complexity.
Like most things, it is best to use monads for a while and
get comfortable with them before trying to learn how to design
them and build them.

Regards,
Yitz
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: [Haskell] Top Level -

2008-09-03 Thread Ashley Yakeley

Sittampalam, Ganesh wrote:
I think it treats them as compatible, using the fact that 
Data.Typeable returns the same type reps (which was why I initially

mentioned Data.Typeable in this thread). This is fine for normal
modules. There's a bit of description in the Dynamic Typing section of
http://www.cse.unsw.edu.au/~dons/hs-plugins/hs-plugins-Z-H-5.html#node_s
ec_9

It's clearly the wrong thing to do for Data.Unique and any anything
else that might use -; but if there are no such types in the interface
of the plugin, then it won't matter. I can't see how to make it
safe to pass Data.Unique etc across a plugin interface without
severely restricting the possible implementation strategies for
a plugin library and its host.


I think it's bad design for a dynamic loader to load a module more than 
once anyway. It's a waste of memory, for a start. We already know that 
hs-plugins won't for modules it already loaded itself (apparently it 
crashes the RTS), and I suspect it doesn't at all.


--
Ashley Yakeley
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] RE: [Haskell] Top Level -

2008-09-03 Thread Sittampalam, Ganesh
Ashley Yakeley wrote:

 I think it's bad design for a dynamic loader to load a module more 
 than once anyway.

In compiled code module boundaries don't necessarily exist. So how
do you relink the loaded code so that it points to the unique copy
of the module?

 It's a waste of memory, for a start. We already 
 know that hs-plugins won't for modules it already loaded itself
 (apparently it crashes the RTS), and I suspect it doesn't at all.

It crashes the RTS of the plugins loader, which is based on ghci, which
is built around loading modules independently. I believe there's a
separate RTS running at the top level of the program which has no
knowledge of the plugin loader.

Ganesh

==
Please access the attached hyperlink for an important electronic communications 
disclaimer: 

http://www.credit-suisse.com/legal/en/disclaimer_email_ib.html
==

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Is it usual to read a Maybe (IORef a) ?

2008-09-03 Thread minh thu
Hi,

I'd like to write a data structure to be used inside the IO monad.
The structure has some handles of type Maybe (IORef a),
i.e. IORef are pointers and the Maybe is like null pointers.

So I came up with the following functions :

readHandle :: Maybe (IORef a) - IO (Maybe a)
readField :: (a - b) - Maybe (IORef a) - IO (Maybe b)

readHandle Nothing  = do
  return Nothing
readHandle (Just r) = do
  v - readIORef r
  return $ Just v

readField f h = do
  m - readHandle h
  return $ fmap f m

Is it something usual ?
Are there any related functions in the standard libraries ?

Thanks,
Thu
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: [Haskell] Top Level -

2008-09-03 Thread Yitzchak Gale
Ashley Yakeley wrote:
 Currently Data.Unique uses the NOINLINE unsafePerformIO
 hack to create its MVar. If hs-plugins duplicates that MVar,
 that's a bug in hs-plugins.

Sittampalam, Ganesh wrote:
 Also, the definition of NOINLINE in the report doesn't
 preclude copying both the MVar *and* its use sites,

Right. It would not be a bug in hs-plugins. That is the most
urgent problem right now.

It is nice to discuss various proposed new language
features. That is the way to solve the problem in
the long term.

But right now - there is no way to do this in Haskell at
all. The NOINLINE unsafePerformIO hack doesn't really
work. This is currently a major hole in Haskell in my
opinion.

For the short term - can we *please* get an ONLYONCE
pragma that has the correct semantics?

Thanks,
Yitz
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


RE: [Haskell-cafe] Re: [Haskell] Top Level -

2008-09-03 Thread Sittampalam, Ganesh
Yitzhak Gale wrote:

 Right. It would not be a bug in hs-plugins. That is
 the most urgent problem right now.
[...]
 For the short term - can we *please* get an ONLYONCE
 pragma that has the correct semantics?

So the purpose of this pragma would solely be so that
you can declare hs-plugins buggy for not respecting it?
Or do you have some way to fix hs-plugins so that it
does do so?

(Assuming that my belief about how hs-plugins works is
correct, of course)

Ganesh

==
Please access the attached hyperlink for an important electronic communications 
disclaimer: 

http://www.credit-suisse.com/legal/en/disclaimer_email_ib.html
==

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Is it usual to read a Maybe (IORef a) ?

2008-09-03 Thread Bulat Ziganshin
Hello minh,

Wednesday, September 3, 2008, 2:09:38 PM, you wrote:

 I'd like to write a data structure to be used inside the IO monad.
 The structure has some handles of type Maybe (IORef a),
 i.e. IORef are pointers and the Maybe is like null pointers.

i've not used this but overall it seems like a correct way to emulate
NULL. the whole question is that you probably still think C if you
need NULL pointers at all :)

 readHandle :: Maybe (IORef a) - IO (Maybe a)

 Are there any related functions in the standard libraries ?

readHandle = maybe (return Nothing) (fmap Just . readIORef)

or you can add your own primitive:

liftNULL op = maybe (return Nothing) (fmap Just . op)

readHandle = liftNULL readIORef



-- 
Best regards,
 Bulatmailto:[EMAIL PROTECTED]

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Types and Trees

2008-09-03 Thread Matt Morrow
I really learned a lot from writing the below code,
and thought I'd share it with the group. I'm slightly
at a loss for words, having just spent the last two
hours on this when I most certainly should have
been doing other work, but these are two hours
I won't regret. I'm very interested in hearing
others' thoughts on this, where this is
whatever comes to mind.

Regards,
Matt

{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}

module TT where

import Data.Tree
import Data.Typeable
 (Typeable(..),TypeRep(..),TyCon(..)
 ,typeRepTyCon,typeRepArgs,tyConString)
import Language.Haskell.TH(Type(..),mkName)



class ToType a where
 toType :: a - Type

class ToTree a b where
 toTree :: a - Tree b

{-
   Typeable a
   |
 typeOf | (0)
   |
   v toType
 TypeRep  - - - - - - - -   Type
   | (4) |
 toTree | (1)   (2) | toTree
   |  |
   v (3)v
   Tree TyCon  ---  Tree Type
 toTree

-}

-- (0)
typeableToTypeRep :: (Typeable a) = a - TypeRep
typeableToTypeRep = typeOf

-- (1)
instance ToTree TypeRep TyCon where
 toTree ty = Node (typeRepTyCon ty)
   (fmap toTree . typeRepArgs $ ty)

-- (2)
instance ToTree Type Type where
 toTree (AppT t1 t2) =
   let (Node x xs) = toTree t1
   in Node x (xs ++ [toTree t2])
 toTree t = Node t []

-- (3.a)
instance ToType TyCon where
 toType tyC = let tyS = tyConString tyC
   in case tyS of
   -- ArrowT
   []- ListT
   ()- TupleT 0
   ('(':',':rest)  - let n = length
   (takeWhile (==',') rest)
  in TupleT (n+2)
   _   - ConT . mkName $ tyS

-- (3.b)
instance ToType (Tree TyCon) where
 toType (Node x xs) =
   foldl AppT (toType x)
   (fmap toType xs)

-- (3)
instance ToTree (Tree TyCon) Type where
 toTree = toTree . toType

-- (4)
instance ToType TypeRep where
 toType = toType . (toTree::TypeRep-Tree TyCon)

-- (0)  typeOf
-- (1)  toTree
-- (2)  toTree
-- (3)  toTree
-- (4)  toType

-- (0) - (1)
tyConTree :: (Typeable a) = a - Tree TyCon
tyConTree = toTree . typeOf

-- (0) - (1) - (3)
typeTree_a :: (Typeable a) = a - Tree Type
typeTree_a = (toTree::Tree TyCon-Tree Type)
 . (toTree::TypeRep-Tree TyCon)
   . typeOf

-- (0) - (4) - (2)
typeTree_b :: (Typeable a) = a - Tree Type
typeTree_b = (toTree::Type-Tree Type)
 . (toType::TypeRep-Type)
   . typeOf


diagram_commutes :: (Typeable a) = a - Bool
diagram_commutes a = typeTree_a a == typeTree_b a

-- ghci diagram_commutes x0
-- True
x0 :: (Num a) = ((a,(a,((a,a),a))),(a,(a,a)))
x0 = ((0,(0,((0,0),0))),(0,(0,0)))



printTree :: (Show a) = Tree a - IO ()
printTree = putStr . drawTree . fmap show

printForest :: (Show a) = Forest a - IO ()
printForest = putStr . drawForest . (fmap . fmap) show


{-

ghci printTree $ tyConTree  x0
(,)
|
+- (,)
|  |
|  +- Integer
|  |
|  `- (,)
| |
| +- Integer
| |
| `- (,)
||
|+- (,)
||  |
||  +- Integer
||  |
||  `- Integer
||
|`- Integer
|
`- (,)
  |
  +- Integer
  |
  `- (,)
 |
 +- Integer
 |
 `- Integer


ghci printTree $ typeTree_a x0
TupleT 2
|
+- TupleT 2
|  |
|  +- ConT Integer
|  |
|  `- TupleT 2
| |
| +- ConT Integer
| |
| `- TupleT 2
||
|+- TupleT 2
||  |
||  +- ConT Integer
||  |
||  `- ConT Integer
||
|`- ConT Integer
|
`- TupleT 2
  |
  +- ConT Integer
  |
  `- TupleT 2
 |
 +- ConT Integer
 |
 `- ConT Integer


ghci printTree $ typeTree_b x0
TupleT 2
|
+- TupleT 2
|  |
|  +- ConT Integer
|  |
|  `- TupleT 2
| |
| +- ConT Integer
| |
| `- TupleT 2
||
|+- TupleT 2
||  |
||  +- ConT Integer
||  |
||  `- ConT Integer
||
|`- ConT Integer
|
`- TupleT 2
  |
  +- ConT Integer
  |
  `- TupleT 2
 |
 +- ConT Integer
 |
 `- ConT Integer

-}

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Is it usual to read a Maybe (IORef a) ?

2008-09-03 Thread Ryan Ingram
Looks like MaybeT?
http://hackage.haskell.org/cgi-bin/hackage-scripts/package/MaybeT-0.1.1

 readHandle x = runMaybeT $ do
 ref -  MaybeT (return x)
 liftIO (readIORef ref)
 readField f h = runMaybeT $ do
 a - MaybeT (readHandle h)
 return (f a)

(or, the short version)
 readHandle x = runMaybeT (liftIO . readIORef = MaybeT (return x))
 readField f = runMaybeT . liftM f . MaybeT . readHandle

As a bonus, readHandle and readField work in any MonadIO due to the
use of liftIO (as opposed to just lift).

  -- ryan





On Wed, Sep 3, 2008 at 3:09 AM, minh thu [EMAIL PROTECTED] wrote:
 Hi,

 I'd like to write a data structure to be used inside the IO monad.
 The structure has some handles of type Maybe (IORef a),
 i.e. IORef are pointers and the Maybe is like null pointers.

 So I came up with the following functions :

 readHandle :: Maybe (IORef a) - IO (Maybe a)
 readField :: (a - b) - Maybe (IORef a) - IO (Maybe b)

 readHandle Nothing  = do
  return Nothing
 readHandle (Just r) = do
  v - readIORef r
  return $ Just v

 readField f h = do
  m - readHandle h
  return $ fmap f m

 Is it something usual ?
 Are there any related functions in the standard libraries ?

 Thanks,
 Thu
 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: [Haskell] Top Level -

2008-09-03 Thread Yitzchak Gale
I wrote:
 For the short term - can we *please* get an ONLYONCE
 pragma that has the correct semantics?

Sittampalam, Ganesh wrote:
 So the purpose of this pragma would solely be so that
 you can declare hs-plugins buggy for not respecting it?

No, the hs-plugins problem - whether hypothetical or
real - is only a symptom.

There is no way to define global variables in Haskell
right now. The NOINLINE hack is used, and most often
works. But really it's broken and there are no guarantees,
because NOINLINE does not have the right semantics.
This is demonstrated by your hs-plugins example, but
it's a general problem.

Until a permanent solution is implemented and deployed
in the compilers (if ever), can we please have a pragma
that allows the current hack to really work?

Thanks,
Yitz
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


RE: [Haskell-cafe] Re: [Haskell] Top Level -

2008-09-03 Thread Sittampalam, Ganesh
(apologies for misspelling your name when quoting you last time) 
Yitzchak Gale wrote:
 For the short term - can we *please* get an ONLYONCE pragma that has

 the correct semantics?

 Until a permanent solution is implemented and deployed in the 
 compilers (if ever), can we please have a pragma that allows
 the current hack to really work?

How do you propose that this pragma would be implemented?

Ganesh

==
Please access the attached hyperlink for an important electronic communications 
disclaimer: 

http://www.credit-suisse.com/legal/en/disclaimer_email_ib.html
==

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Is it usual to read a Maybe (IORef a) ?

2008-09-03 Thread minh thu
2008/9/3 Bulat Ziganshin [EMAIL PROTECTED]:
 Hello minh,

 Wednesday, September 3, 2008, 2:09:38 PM, you wrote:

 I'd like to write a data structure to be used inside the IO monad.
 The structure has some handles of type Maybe (IORef a),
 i.e. IORef are pointers and the Maybe is like null pointers.

 i've not used this but overall it seems like a correct way to emulate
 NULL. the whole question is that you probably still think C if you
 need NULL pointers at all :)

Maybe, I'm adapting some C++ code...

Do you suggest I use

data Thing = Thing | None

and IORef Thing instead of

data Thing = Thing

and Maybe (IORef Thing) ?

I'm writing a data structure that can hold  Things (and that can be mutated) or
nothing (there is a hole in the wrapping data).

Thanks,
Thu
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: [Haskell] Top Level -

2008-09-03 Thread Yitzchak Gale
 For the short term - can we *please* get an ONLYONCE pragma that has
 the correct semantics?

Sittampalam, Ganesh wrote:
 How do you propose that this pragma would be implemented?

As far as I know now, in GHC it could currently just be
an alias for NOINLINE, but the GHC gurus could say for sure.
Except it should require a monomorphic constant - otherwise
the guarantee doesn't make sense.

And it would have clear comments and documentation
that state that it guarantees that the value will be computed
at most once. That way, bugs could be filed against it if
that ever turns out not to be true.

Other applications and libraries that support the pragma -
such as other compilers, and hs-plugins - would be required
to respect the guarantee, and bugs could be filed against
them if they don't.

Thanks,
Yitz
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


RE: [Haskell-cafe] Re: [Haskell] Top Level -

2008-09-03 Thread Sittampalam, Ganesh
Yitzchak Gale wrote

 Other applications and libraries that support the pragma - such as
other 
 compilers, and hs-plugins - would be required to respect the
guarantee, and  bugs could be filed against them if they don't.

If hs-plugins were loading object code, how would it even know of the
existence of the pragma? Given such knowledge, how would it implement
it?

Ganesh

==
Please access the attached hyperlink for an important electronic communications 
disclaimer: 

http://www.credit-suisse.com/legal/en/disclaimer_email_ib.html
==

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: [Haskell] Top Level -

2008-09-03 Thread Yitzchak Gale
I wrote
 Other applications and libraries that support the pragma -
 such as other compilers, and hs-plugins - would be
 required to respect the guarantee, and bugs could be
 filed against them if they don't.

Sittampalam, Ganesh wrote:
 If hs-plugins were loading object code, how would it even
 know of the existence of the pragma? Given such
 knowledge, how would it implement it?

Good point. A compiler pragma is only that, in the end.
This is just a hack, we can only do the best we can
with it.

Regards,
Yitz
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Is it usual to read a Maybe (IORef a) ?

2008-09-03 Thread minh thu
2008/9/3 Lennart Augustsson [EMAIL PROTECTED]:
 I think you should think about why your application needs IORef at all. Do
 you really need mutation?  And why isn't STRef good enough. Using IORef is
 really the last resort.

This is for an interactive application (3D mesh editing, the data structure is
the half edge structure). So the user can add points, edges, faces,
delete them, ...

Thu
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: joyent, solaris and ghc

2008-09-03 Thread Christian Maeder

Jason Dusek wrote:

  Is anyone on the list using GHC on Joyent's Solaris (x86_64)
  setup? If so, I would love to know whether it was easy/hard
  and what the process is.


Sorry, I don't know a thing about Joyent. On x86-Solaris there seems 
to exist only a 32bit distribution that should run on 64bit archs, too.


http://www.haskell.org/ghc/download_ghc_683.html#x86solaris

Could you try that out?
Cheers Christian
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: [Haskell] Top Level -

2008-09-03 Thread David Menendez
On Wed, Sep 3, 2008 at 9:30 AM, Yitzchak Gale [EMAIL PROTECTED] wrote:
 I wrote
 Other applications and libraries that support the pragma -
 such as other compilers, and hs-plugins - would be
 required to respect the guarantee, and bugs could be
 filed against them if they don't.

 Sittampalam, Ganesh wrote:
 If hs-plugins were loading object code, how would it even
 know of the existence of the pragma? Given such
 knowledge, how would it implement it?

 Good point. A compiler pragma is only that, in the end.
 This is just a hack, we can only do the best we can
 with it.

How does the FFI handle initialization? Presumably, we can link to
libraries that have internal state. Could someone, in principle, use
the FFI to create a global variable?

-- 
Dave Menendez [EMAIL PROTECTED]
http://www.eyrie.org/~zednenem/
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Compiler's bane

2008-09-03 Thread Andrew Coppin

Brandon S. Allbery KF8NH wrote:
You can define a set of valid transformations, have the interpreter 
log each transformation, and verify that all are correct (that is, 
that both the transformation and the logged result are correct.


This assumes the interpreter can be resolved down to a sufficiently 
simple set of transformations; if not, you're right back at having the 
tester being the interpreter itself.  Note that you don't check if the 
transformation plan for the program matches a specified list, just 
that all transformations are correct.  (Just remember that logic is 
an organized way of going wrong with confidence.)


The amusing (?) part is that the interpretter itself is essentially 
quite simple. I've implemented it several times before now. But what I'm 
trying to do it make it print out elaborately formatted execution traces 
so that a human user can observe how execution proceeds. This transforms 
an essentially simple algorithm into something quite nausiatingly 
complex, with many subtle bugs and issues.


Still, I guess it's not news to anybody that proof-of-concept programs 
are much easier that real-world implementations.


One thing I could do is have QuickCheck build arbitrary expressions, run 
those through the pretty printer, and then run the result back through 
the parser and check that I get the same expression. Can anybody tell me 
how to get QuickCheck to build arbitrary expressions though? Let's say I had


 data Expression = Var String | Apply Expression Expression | Lambda 
String Expression


How would you go about building random expression trees?


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Compiler's bane

2008-09-03 Thread Andrew Coppin

Brandon S. Allbery KF8NH wrote:

On 2008 Sep 1, at 14:47, Andrew Coppin wrote:
I wonder - how do the GHC developers check that GHC works properly? 
(I guess by compiling stuff and running it... It's a bit harder to 
check that a lambda interpretter is working right.)


GHC has a comprehensive test suite (not included in the source tarball 
or the default checkout but easily checked out atop GHC).


I'm sure a large, complex product like GHC would have a large test 
suite. I was asking how it works. ;-)


Since GHC actually transforms Haskell to machine code in several stages, 
I presume each one can be checked independently, which probably makes 
things easier. But I bet the GHC developers don't have any way to just 
automatically build 1,000 random test cases and check that the compiler 
works for those...


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Is it usual to read a Maybe (IORef a) ?

2008-09-03 Thread hs
On Wednesday 03 September 2008 12:09:38 minh thu wrote:
 Hi,

 I'd like to write a data structure to be used inside the IO monad.
 The structure has some handles of type Maybe (IORef a),
 i.e. IORef are pointers and the Maybe is like null pointers.

 So I came up with the following functions :

 readHandle :: Maybe (IORef a) - IO (Maybe a)
 readField :: (a - b) - Maybe (IORef a) - IO (Maybe b)

 readHandle Nothing  = do
   return Nothing
 readHandle (Just r) = do
   v - readIORef r
   return $ Just v

 readField f h = do
   m - readHandle h
   return $ fmap f m

 Is it something usual ?
 Are there any related functions in the standard libraries ?

A value of type Maybe (IORef a) is an optional pointer that must point to an 
object. If you want a pointer that points to either Nothing (aka null) or to a 
value, you should use IORef (Maybe a).

Then 

readHandle :: IORef (Maybe a) - IO (Maybe a)
readHandle = readIORef

readfield :: (a - b) - IORef (Maybe a) - IO (Maybe b)
readfield f p = (fmap . fmap) f (readIORef p)


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: [Haskell] Top Level -

2008-09-03 Thread Ashley Yakeley

Sittampalam, Ganesh wrote:

In compiled code module boundaries don't necessarily exist. So how
do you relink the loaded code so that it points to the unique copy
of the module?


hs-plugins loads modules as single .o files, I believe.


It crashes the RTS of the plugins loader, which is based on ghci, which
is built around loading modules independently. I believe there's a
separate RTS running at the top level of the program which has no
knowledge of the plugin loader.


Two RTSs? Are you quite sure? How would GC work?

The loader is a binding to the GHC runtime system's dynamic linker, 
which does single object loading. GHC also performs the necessary 
linking of new objects into the running process.

http://www.cse.unsw.edu.au/~dons/hs-plugins/hs-plugins-Z-H-2.html#node_sec_4

--
Ashley Yakeley
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Hackage - MacPorts?

2008-09-03 Thread John MacFarlane
It would be great if there were an automated or semi-automated way
of generating a MacPorts Portfile from a HackageDB package, along
the lines of dons' cabal2arch. Has anyone been working on such a thing?
And, are any haskell-cafe readers MacPorts committers?

John

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] analyzing modules import/export

2008-09-03 Thread Han Joosten

I am currently involved with a Haskell project to create a toolset for a
formal language. The toolset contains a parser, a typechecker and s range of
other features. 
The Haskell code currently consists of about 20 modules. I am new in the
project, and my impression is that a lot of code does not reside in the
proper module. I would like to be able to get a good feeling in how the
modules are structured, and how they are consumed by other modules. This
would enable me to clean up a little bit. 
I use eclipsefp. Do you know of any way to get insight of the structure of
modules? is any tooling available?
Any suggestions would help a lot! Thanx for reading. 

Han Joosten

-- 
View this message in context: 
http://www.nabble.com/analyzing-modules-import-export-tp19297359p19297359.html
Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Hackage - MacPorts?

2008-09-03 Thread Duncan Coutts
On Wed, 2008-09-03 at 13:14 -0700, John MacFarlane wrote:
 It would be great if there were an automated or semi-automated way
 of generating a MacPorts Portfile from a HackageDB package, along
 the lines of dons' cabal2arch. Has anyone been working on such a thing?
 And, are any haskell-cafe readers MacPorts committers?

Whoever starts on this should not start from scratch. We now have
several of these tools so there's lots of code to look at but ideally we
should be sharing more code.

One possible plan I have is for cabal-install to be a lib and a tool
because there's a lot of useful code in there that these tools could
re-use and share.

Duncan

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] analyzing modules import/export

2008-09-03 Thread Don Stewart
j.m.m.joosten:
 
 I am currently involved with a Haskell project to create a toolset for a
 formal language. The toolset contains a parser, a typechecker and s range of
 other features. 

 The Haskell code currently consists of about 20 modules. I am new in
 the project, and my impression is that a lot of code does not reside
 in the proper module. I would like to be able to get a good feeling in
 how the modules are structured, and how they are consumed by other
 modules. This would enable me to clean up a little bit. 

 I use eclipsefp. Do you know of any way to get insight of the
 structure of modules? is any tooling available?  Any suggestions would
 help a lot! Thanx for reading. 

There's been a few projects at Galois for this kind of high level
structural analysis. We're trying to polish them up into a release. 

For now, there's one tool you can get started with: graphmod.

This tool was written by Andy Gill (the dotgen part) and Iavor Diatchki
(the graphmod part),  and you can use it like so:

$ git clone http://code.haskell.org/graphmod.git
$ cd graphmod

-- build dotgen
$ cd dotgen
.. edit the .cabal file to add the line:
Build-type:  Simple
   after the Exposed-modules line
$ cabal install

-- build graphmod
$ cd ..
$ cabal install
...
Installing: /home/dons/.cabal/bin

Now you have 'graphmod' a tool for drawing the module structure. 
So go find a project, and analyze it:

$ cd ~/xmonad

-- generate module graph
$ graphmod XMonad XMonad.hs Main.hs  /tmp/xmonad.dot

-- generate svg of graph
$ dot -Tsvg /tmp/xmonad.dot  xmonad.svg

Which gives this result:

http://galois.com/~dons/images/xmonad.svg

Enjoy!

-- Don
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Hackage - MacPorts?

2008-09-03 Thread Don Stewart
duncan.coutts:
 On Wed, 2008-09-03 at 13:14 -0700, John MacFarlane wrote:
  It would be great if there were an automated or semi-automated way
  of generating a MacPorts Portfile from a HackageDB package, along
  the lines of dons' cabal2arch. Has anyone been working on such a thing?
  And, are any haskell-cafe readers MacPorts committers?
 
 Whoever starts on this should not start from scratch. We now have
 several of these tools so there's lots of code to look at but ideally we
 should be sharing more code.

It seems the front end of cabal2arch -- general parsing and processing
of .cabal files, would be reusable in any tool.

 foo.cabal url
   |
   v
   Parsed cabal file
   |
   v
  Resolved dependencies/flags
   |
   v
  Normalised for Arch
   |
   v
  Translated into ArchPkg ADT
   |
   v
instance Pretty ArchPkg
   |
   v 
foo.tar.gz native Arch package.


You just have to define a data structure for the target output, and a
pretty printer instance, and any platform specific dep differences.

-- Don
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Haskell audio libraries audio formats

2008-09-03 Thread Gwern Branwen
On 2008.08.24 11:41:04 -0400, Eric Kidd [EMAIL PROTECTED] scribbled 3.7K 
characters:
 Greetings, Haskell folks!

 I'm working on a toy program for drum synthesis.  This has lead me to
 explore the various sound-related libraries in Hackage.  Along the way,
 I've learned several things:

   1. There's a lot of Haskell sound libraries, but no agreement on how
  to represent buffers of audio data.
   2. Some of the most useful sound libraries aren't listed in Hackage's
  Sound section, including HCodecs, SDL-mixer and hogg.

Have you contacted the authors to ask they add the Sound categorization? I 
already sent a hogg patch, but couldn't find any darcs repositories for 
SDL-mixer or HCodecs.

...
 No public sound-buffer API:
   hbeat: The relevant source files are missing!

The cabal file was missing the Other-modules field. I've sent the author a 
patch.


--
gwern
Surveillance Defcon S511 anarchy REP NSIRL grenades dort UT/RUS W


signature.asc
Description: Digital signature
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Hackage - MacPorts?

2008-09-03 Thread David Menendez
On Wed, Sep 3, 2008 at 4:14 PM, John MacFarlane [EMAIL PROTECTED] wrote:
 It would be great if there were an automated or semi-automated way
 of generating a MacPorts Portfile from a HackageDB package, along
 the lines of dons' cabal2arch. Has anyone been working on such a thing?
 And, are any haskell-cafe readers MacPorts committers?

Gregory Wright handles the ports of GHC, alex, happy, haddock, and others.

In my experience thus far, MacPorts feels like a poor match for Cabal.
As far as I can tell, you get at most one active installation of a
given port, which means you can't use MacPorts to manage packages for
multiple Haskell environments (GHC and Hugs, stable GHC and
development GHC, etc.), and after a GHC upgrade, any installed Haskell
packages will still be installed, even though the new GHC can't see or
use them.

-- 
Dave Menendez [EMAIL PROTECTED]
http://www.eyrie.org/~zednenem/
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Compiler's bane

2008-09-03 Thread Ryan Ingram
On Wed, Sep 3, 2008 at 11:34 AM, Andrew Coppin
[EMAIL PROTECTED] wrote:
  data Expression = Var String | Apply Expression Expression | Lambda String
 Expression

 How would you go about building random expression trees?

It's pretty simple, I think.  Keep an environment of variable names
that are in enclosing lambdas, then randomly choose Apply/Lambda/Var,
ignoring Var if the environment is empty, and with Lambda adding to
the environment of its subexpression.

I suggest

type ExpGen = ReaderT [String] Gen

arbExp :: ExpGen Expression
-- exercise for the reader

instance Arbitrary Expression where
arbitrary = runReaderT arbExp []
coarbitrary = coarbExp

coarbExp (Var s)  = variant 0 . coarbitrary s
coarbExp (Apply a b)  = variant 1 . coarbitrary a . coarbitrary b
coarbExp (Lambda s e) = variant 2 . coarbitrary s . coarbitrary e

-- Also, apparently there is no default Arbitrary instance for strings, so...
instance Arbitrary Char where
  arbitrary   = elements abcdefghijklmnopqrstuvwxyz_
  coarbitrary = coarbitrary . fromEnum


Here's some examples I got with a quick and dirty implementation for arbExp:
Lambda  (Lambda  (Var ))
Lambda jae (Lambda iq (Var jae))
Lambda sj (Lambda  (Var ))
Lambda n (Var n)
Lambda lxy (Lambda md_fy (Lambda b (Var b)))
Lambda  (Apply (Lambda  (Var )) (Lambda  (Lambda  (Var 
Lambda vve (Lambda mvy (Var vve))
Lambda  (Apply (Apply (Var ) (Lambda km (Var km))) (Var ))
Lambda  (Lambda _ (Var ))
Lambda aeq (Var aeq)
Lambda l_ (Apply (Var l_) (Lambda  (Var l_)))

My implementation doesn't choose Apply nearly enough, but I was
worried about exponential blowup; the solution is to use the sized
combinator from QuickCheck and have the size determine the number of
Apply you are allowed to have.

It's also probably a good idea to not allow empty strings for variable names :)

  -- ryan
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Compiler's bane

2008-09-03 Thread Brandon S. Allbery KF8NH

On 2008 Sep 3, at 14:34, Andrew Coppin wrote:

Brandon S. Allbery KF8NH wrote:
You can define a set of valid transformations, have the interpreter  
log each transformation, and verify that all are correct (that is,  
that both the transformation and the logged result are correct.


This assumes the interpreter can be resolved down to a sufficiently  
simple set of transformations; if not, you're right back at having  
the tester being the interpreter itself.  Note that you don't check  
if the transformation plan for the program matches a specified  
list, just that all transformations are correct.  (Just remember  
that logic is an organized way of going wrong with confidence.)


The amusing (?) part is that the interpretter itself is essentially  
quite simple. I've implemented it several times before now. But what  
I'm trying to do it make it print out elaborately formatted  
execution traces so that a human user can observe how execution  
proceeds. This transforms an essentially simple algorithm into  
something quite nausiatingly complex, with many subtle bugs and  
issues.


This seems odd to me:  I would expect to wrap a WriterT around it, log  
unformatted actions there, and dump it to a file at the end to be read  
by an analyzer tool which can optionally reformat the log to be human- 
readable.


--
brandon s. allbery [solaris,freebsd,perl,pugs,haskell] [EMAIL PROTECTED]
system administrator [openafs,heimdal,too many hats] [EMAIL PROTECTED]
electrical and computer engineering, carnegie mellon universityKF8NH


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Research language vs. professional language

2008-09-03 Thread wren ng thornton

Jonathan Cast wrote:

 But Haskell's community is also growing

This is good!

  and becoming more
 results-oriented.

This is not; see my other post.  I think it's great that Haskellers are
starting to accomplish useful things, but if in the process I think
elders like Lennart Augustsson and Paul Hudak are starting to be
ignored.  Hair-shirt wearers need to have someplace to live.  Up until
recently, that's been Haskell.  I can't help seeing putting things like
ad-hoc overloading or ACIO into Haskell as theft of that territory from
them, and I think it's incumbent upon those who would do such a thing to
propose where the hair-shirt wearers are going to receive asylum now
that they're being expelled from Haskell.


I can't express how strongly I agree with this. For me, the most 
fundamental and radical idea of Haskell is the idea of purity. For a 
long time functional languages have claimed the moral high ground, but 
they've all made concessions against purity. In a world dominated by 
impure procedural languages, it is imperative to have a language which 
is unwilling to make concessions for the sake of expediency. Moreover, 
it is imperative to have a language which is just as vehement about 
finding the correct answer as it is unwilling to concede. I'm eternally 
grateful that Haskell has had that vehemence, because it means I can use 
it in day-to-day programming and at work. But sacrificing that purity 
for daily expediency defeats the whole exercise. If it can't be done 
purely then we're doing it wrong. I chose to don the hair shirt.




 So, my question for you is: if Haskell is a research language, what
 direction should it be taking?  What changes should be happening at
 the language (not the library) level that are in the interests of
 improving the state-of-the-art in functional programming?


* Extensible records, seconding Jonathan Cast.

* Extensible unions. Something combining Datatypes a la Carte with the 
work on Bit-C to allow construction of ad-hoc unions as well as 
specifying how the unions are tagged, all while ensuring safety. DTalC 
is nice but it would be nicer if we could use, say, a Huffman encoding 
of the coproduct tag rather than just a linear encoding.


* Inference with type-classes (and fundeps). How exactly we determine 
the correct instance to choose has some irksome limitations at present. 
It would be nice to explore how much of logic programming we could lift 
into this decision without ruining performance. Many of the proposals 
for haskell' to deal with MPTC are in a similar vein.


* Refinement types. Doing this purely would help capture a wide genre of 
OO-like ad-hoc polymorphism, and it would let us totalize partial 
functions like `head` and `div`.


* Top-level mutable variables, dynamic linking. This is also seconding 
Cast, but I mention it more in the vein of capability systems and 
component-based programming. Having a coherent story for how programs 
are constructed from components/modules including all the gritty bits 
about duplicating components and wiring them together efficiently; that 
is, can we take the compositional and applicative features of functional 
programming and apply them to the module layer?


* Distributed processes. This is more in the vein of Erlang, but an 
exploration of the problem space seems to be in order. This feels very 
similar to the previous point, though one of the key focuses here would 
be on the memory model and GC.


* Effect systems, in particular the composition of effects. Monads are 
nice and fun, but they do sort of paint one into a corner 
language-design-wise: once you use them to encapsulate effects, that 
forces your hand when it comes to combining effects etc. Also, this 
essentially gives us two orders of evaluation: by-need for pure values, 
and sequentially for effectful values. What about other orders for 
effectful values? What about breaking up the sin bin of IO? Studying 
this in depth would most likely fork the language, but there is still 
research to be done.




 My goal is
 to make it not be a joke when I go to work and suggest that we use
 Haskell for part of our next project.  What is yours?

My goal is to ensure there's an even better language to propose using 10
years from now.


Again, ditto Cast. In ten years I want a language that's as far ahead of 
Haskell as Haskell is ahead of the other languages out there today.



--
Live well,
~wren
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [haskell-cafe] Monad and kinds

2008-09-03 Thread wren ng thornton

Ramin wrote:
Hello, I'm new here, but in the short time I have known Haskell, I can 
already say it's my favorite computer language.


Except for monads, and no matter how many tutorials I read, I find the 
only kind of monad I can write is the monad that I copied and pasted 
from the tutorial, i.e. I still don't get it even though I thought I 
understood the tutorial, and I'm stuck using monads others have already 
written.


My project is this: I am writing a mini-database of sorts. I thought I 
would make a query a monad, so I could chain multiple queries together 
using the do notation, and run more complex queries on the list in one 
shot. The query itself is stateful because it contains information that 
changes as the database is traversed. The query may also make updates to 
the records. I got the program to work perfectly using purely functional 
techniques, but complex queries resulted in that stair-step looking 
code. So I thought this would be the perfect opportunity to try my hand 
at monads.


The query monad I wrote looks something like this (much simplified):
   data Query state rec = Query !(state, rec)


A minor point but, that strictness annotation doesn't help you very much 
since tuples are lazy in their arguments. That declaration has the same 
strictness properties as:


data Query state rec = Query state rec

The only difference is that your version gives you the free ability to 
 convert from a (Query s r) to a (s,r). The free is in quotes because 
either there's a cost in indirection to access the state and rec fields, 
or you've told GHC to optimize the tuple away in which case there's a 
cost in reconstructing the tuple when demanded.[1] Sometimes there's a 
reason to use a type like this, but generally it's not what was intended.


If you want the datatype to be strict in state and rec, then you should 
add strictness annotations to those fields directly:


data Query state rec = Query !state !rec


[1] That is, when a tuple _really_ is demanded. GHC does a good job of 
replacing tuples with unboxed-tuples when optimizations are turned on. 
In these cases the code isn't really asking for a tuple so one needn't 
be reconstructed.


--
Live well,
~wren
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Haskell and i18n (aka gettext) support

2008-09-03 Thread Gour
Dear Haskellers,

Some time ago the question was asked on gtk2hs mailing list about how to
work with *.po files, i.e. how to make Haskell program i18n-aware. (see
http://thread.gmane.org/gmane.comp.lang.haskell.gtk2hs/592) 

The answer was that Gtk2hs does not have gettext support
(http://article.gmane.org/gmane.comp.lang.haskell.gtk2hs/593), but that
it is something which is needed
(http://article.gmane.org/gmane.comp.lang.haskell.gtk2hs/598) but it's
not clear how to do it.

As potential 'solution the 'i18n' package was mentioned
(http://hackage.haskell.org/cgi-bin/hackage-scripts/package/i18n) with
the remark that its API is not the most beautiful.

Moreover, by looking at i18n's *.cabal file one can see it is labelled
as 'experimental'.

Moreover, if one inspects GNU gettext manual one can see the list of
languages with the explanations how to make the program i18n-ready.

The list is, unfortunately, without Haskell:

* C: C, C++, Objective C
* sh: sh - Shell Script
* bash: bash - Bourne-Again Shell Script
* Python: Python
* Common Lisp: GNU clisp - Common Lisp
* clisp C: GNU clisp C sources
* Emacs Lisp: Emacs Lisp
* librep: librep
* Scheme: GNU guile - Scheme
* Smalltalk: GNU Smalltalk
* Java: Java
* C#: C#
* gawk: GNU awk
* Pascal: Pascal - Free Pascal Compiler
* wxWidgets: wxWidgets library
* YCP: YCP - YaST2 scripting language
* Tcl: Tcl - Tk's scripting language
* Perl: Perl
* PHP: PHP Hypertext Preprocessor
* Pike: Pike
* GCC-source: GNU Compiler Collection sources 

Real World Haskell book is at the door and it will bring army of new
Haskell programmers to find out that Haskell misses one of the important
items in its battery set. :-(

So, we think that i18n issue or proper gettext support should have a
stable and well documented implementation and has to be part of
batteries included or Haskell Platform
(http://www.haskell.org/haskellwiki/Haskell_Platform) 

However, don't ask me 'how' :-D

We got some hints on the IRC yesterday, but considering it is important
issue for the whole Haskell community, we are bringing it here so that
smarter and more skillful (than ourselves) souls can discuss it.

I hope you are not seeing it as critique of the Haskell, but rather as
attempt to improve our beloved language with the feature necessary to be
included in the arsenal of every general programming language.


Sincerely,
Gour

-- 

Gour  | Zagreb, Croatia  | GPG key: C6E7162D



pgpXpOnrsur1p.pgp
Description: PGP signature
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe