Re: problems with impredicativity

2011-11-07 Thread Wolfgang Jeltsch
Am Freitag, den 04.11.2011, 20:16 -0400 schrieb wagne...@seas.upenn.edu:
 Quoting wagne...@seas.upenn.edu:
 
  Quoting Wolfgang Jeltsch g9ks1...@acme.softbase.org:
 
  this code is accepted by GHC 7.0.4:
  snip
  However, this one isn?t:
 
  {-# LANGUAGE ImpredicativeTypes #-}
 
  polyId :: (forall a. Maybe a) - Maybe a
  polyId x = x
 
  polyIdMap :: [forall a. Maybe a] - [forall a. Maybe a]
  polyIdMap xs = fmap polyId xs
 
  Is there a way to make it accepted?

 […]
 
 The first thing to observe is that, ideally, the following two types  
 would mean slightly different things:
 
 polyId :: forall b. (forall a. Maybe a) - Maybe b
 polyId :: (forall a. Maybe a) - (forall b. Maybe b)

 […]

 Unfortunately, in GHC, these two types do not mean different things:  
 foralls on the result side of an arrow are silently floated to the  
 top level, even if you explicitly choose to put them later in your  
 type annotation.

That’s the problem. I could have written the second type in the type
signature, which would directly express my intension, but I didn’t,
since GHC silently transforms it into the first type anyway.

 The only way I know of to prevent this is to make a newtype barrier.

This is what I already thought of worth trying.

 For example, the following works:
 
 newtype PolyMaybe = PolyMaybe (forall a. Maybe a)
 
 polyId :: PolyMaybe - PolyMaybe
 polyId x = x
 
 polyIdMap :: [PolyMaybe] - [PolyMaybe]
 polyIdMap xs = fmap polyId xs
 
 Then, later, you can unwrap the PolyMaybe -- but only when you're  
 ready to turn it into a monomorphic Maybe! (Note that none of these  
 things is using ImpredicativeTypes, which is what made me jump to my  
 first, probably mistaken impression of what you were trying to do.  
 Rank2Types is enough for the above to compile.)

I shouldn’t need impredicativity in the result, so I’ll try this route.

 ~d

Best wishes,
Wolfgang


___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Compiling using gmake

2011-11-07 Thread David Fox
On Sat, Nov 5, 2011 at 4:41 PM, Christian Brolin cbro...@gmail.com wrote:
 Hello

 I try to set-up a gnu makefile for compiling Haskell programs with GHC. I
 want to generate dependencies automatically and I want to put my object (.o)
 files in a binary specifc directories to be able to compile for different
 architechtures. The problem is when GHC derives the dependencies it names
 the object file for the Main module to Main.o and not filename.o as it does
 if I don't specifiy an odir. This gives me two problems, first I cannot have
 more than one Main module in the same directory as I often need, e.g. for
 different test programs. The second problem is that it doesn't match my
 compile command which always names the object files after the the source
 files by just changing extensions from .hs to .o. So gmake does not
 recognize dependencies from my Main modules to other modules.

 I am stuck here. Any ideas?

I found early on that trying to use gmake with haskell is a losing
battle.  Maybe you could change your approach to use cabal?   That way
you can specify the build directory using something like runhaskell
Setup --builddir dist-whatever build

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Way to expose BLACKHOLES through an API?

2011-11-07 Thread Ryan Newton
Hi GHC users,

When implementing certain concurrent systems-level software in Haskell
it is good to be aware of all potentially blocking operations.
Presently, blocking on an MVar is explicit (it only happens when you
do a takeMVar), but blocking on a BLACKHOLE is implicit and can
potentially happen anywhere.

If there are known thunks where we, the programmers, know that
contention might occur, would it be possible to create a variant of
Control.Monad.Evaluate that allows us to construct non-blocking
software:

   evaluate :: a - IO a
   evaluateNonblocking :: a - IO (Maybe a)

It would simply return Nothing if the value is BLACKHOLE'd.  Of course
it may be helpful to also distinguish the evaluated and unevaluated
states.  Further, the above simple version allows data-races (it may
become blackhole'd right after we evaluate).  An extreme version would
actively blackhole it to lock the thunk... but maybe that's overkill
and there are some other good ideas out there.

A mechanism like the proposed should, for example, allow us to consume
just as much of a lazy Bytestring as has already been computed by a
producer, WITHOUT blocking and waiting on that producer thread, or
migrating the producer computation over to our own thread (blowing its
cache).

Thanks,
  -Ryan

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: problems with impredicativity

2011-11-07 Thread Wolfgang Jeltsch
Am Montag, den 07.11.2011, 14:49 +0200 schrieb Wolfgang Jeltsch:
 Am Freitag, den 04.11.2011, 20:16 -0400 schrieb wagne...@seas.upenn.edu:
  The first thing to observe is that, ideally, the following two types  
  would mean slightly different things:
  
  polyId :: forall b. (forall a. Maybe a) - Maybe b
  polyId :: (forall a. Maybe a) - (forall b. Maybe b)
 
  […]
 
  Unfortunately, in GHC, these two types do not mean different things:  
  foralls on the result side of an arrow are silently floated to the  
  top level, even if you explicitly choose to put them later in your  
  type annotation.
 
 That’s the problem. I could have written the second type in the type
 signature, which would directly express my intension, but I didn’t,
 since GHC silently transforms it into the first type anyway.
 
  The only way I know of to prevent this is to make a newtype barrier.
 
 This is what I already thought of worth trying.
 
  For example, the following works:
  
  newtype PolyMaybe = PolyMaybe (forall a. Maybe a)
  
  polyId :: PolyMaybe - PolyMaybe
  polyId x = x
  
  polyIdMap :: [PolyMaybe] - [PolyMaybe]
  polyIdMap xs = fmap polyId xs
  
  Then, later, you can unwrap the PolyMaybe -- but only when you're  
  ready to turn it into a monomorphic Maybe! (Note that none of these  
  things is using ImpredicativeTypes, which is what made me jump to my  
  first, probably mistaken impression of what you were trying to do.  
  Rank2Types is enough for the above to compile.)
 
 I shouldn’t need impredicativity in the result, so I’ll try this route.

Yes, this works. Thank you.

Best wishes,
Wolfgang


___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Way to expose BLACKHOLES through an API?

2011-11-07 Thread Ryan Newton
Jan voted for the explicit lockAndBlackhole version as safer.

I realize that for the Bytestring example all you would want to gently
consume what is already available is WHNF detection alone.  In that
scenario you don't want to evaluate anything, just consume what is already
evaluated.

I would propose that when you do want to explicitly and actively blackhole
something that that call be non-blocking (i.e. if someone else has already
blackhole'd you don't wait).  So the state machine would go:

tryAcquire x =
 case unsafeRTStatus x of
   Blackhole   - return Nothing
   Unevaluated - do b - tryBlackhole x
 if b
  then return (Just x)
  else return Nothing
   Evaluated   - return (Just x)




 It would simply return Nothing if the value is BLACKHOLE'd.  Of course
 it may be helpful to also distinguish the evaluated and unevaluated
 states.  Further, the above simple version allows data-races (it may
 become blackhole'd right after we evaluate).  An extreme version would
 actively blackhole it to lock the thunk... but maybe that's overkill
 and there are some other good ideas out there.

 I'd submit that your latter suggestion is far safer: return Nothing
 unless we successfully blackhole the thunk or find that it's already
 been evaluated.  We actually *know* the blocking behavior we'll get,
 and it's behavior we can't easily obtain through any other mechanism
 (eg we'd have to add multiple unsafe indirections through mutable
 cells into the lazy bytestring implementation to obtain the same
 behavior in any other way, and essentially write out the laziness
 longhand losing the benefits of indirection removal and so forth).


 A mechanism like the proposed should, for example, allow us to consume
 just as much of a lazy Bytestring as has already been computed by a
 producer, WITHOUT blocking and waiting on that producer thread, or
 migrating the producer computation over to our own thread (blowing its
 cache).

 For that you probably want WHNF-or-not detection as well (at least if
 you want to schedule streaming of computation.
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: GHC 7.2.2 RC 1

2011-11-07 Thread Simon Marlow
I think we should apply the minimal change to make all packages trusted 
by default in 7.2.2.  Any objections?


Cheers,
Simon

On 06/11/2011 16:36, Chris Dornan wrote:

It's looking good but base is still untrusted out of the box. Is this right?

Chris

-Original Message-
From: glasgow-haskell-users-boun...@haskell.org
[mailto:glasgow-haskell-users-boun...@haskell.org] On Behalf Of Ian Lynagh
Sent: 06 November 2011 13:19
To: glasgow-haskell-users@haskell.org
Subject: GHC 7.2.2 RC 1


We are pleased to announce the first release candidate for GHC 7.2.2:

 http://www.haskell.org/ghc/dist/7.2.2-rc1/

This includes the source tarball, installers for OS X and Windows, and
bindists for amd64/Linux, i386/Linux, amd64/FreeBSD and i386/FreeBSD.

7.2.2 will be a minimal bugfix release, fixing only bugs that cannot be
worked around. Please let us know if you find any showstoppers.


Thanks
Ian, on behalf of the GHC team


___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: behaviour change in getDirectoryContents in GHC 7.2?

2011-11-07 Thread Simon Marlow

On 06/11/2011 16:56, John Millikin wrote:

2011/11/6 Max Bolingbrokebatterseapo...@hotmail.com:

On 6 November 2011 04:14, John Millikinjmilli...@gmail.com  wrote:

For what it's worth, on my Ubuntu system, Nautilus ignores the locale
and just treats all paths as either UTF8 or invalid.
To me, this seems like the most reasonable option; the concept of
locale encoding is entirely vestigal, and should only be used in
certain specialized cases.


Unfortunately non-UTF8 locale encodings are seen in practice quite
often. I'm not sure about Linux, but certainly lots of Windows systems
are configured with a locale encoding like GBK or Big5.


This doesn't really matter for file paths, though. The Win32 file API
uses wide-character functions, which ought to work with Unicode text
regardless of what the user set their locale to.


Paths as text is what *Windows* programmers expect. Paths as bytes is
what's expected by programmers on non-Windows OSes, including Linux
and OS X.


IIRC paths on OS X are guaranteed to be valid UTF-8. The only platform
that uses bytes for paths (that we care about) is Linux.


UTF-8 is bytes. It can be treated as text in some cases, but it's
better to think about it as bytes.


I'm not saying one is inherently better than the other, but
considering that various UNIX  and UNIX-like operating systems have
been using byte-based paths for near on forty years now, trying to
abolish them by redefining the type is not a useful action.


We have to:
  1. Provide an API that makes sense on all our supported OSes
  2. Have getArgs :: IO [String]
  3. Have it such that if you go to your console and write
(./MyHaskellProgram 你好) then getArgs tells you [你好]

Given these constraints I don't see any alternative to PEP-383 behaviour.


Requirement #1 directly contradicts #2 and #3.


If you're going to make all the System.IO stuff use text, at least
give us an escape hatch. The unix package is ideally suited, as it's
already inherently OS-specific. Something like this would be perfect:


You can already do this with the implemented design. We have:

openFile :: FilePath -  IO Handle

The FilePath will be encoded in the fileSystemEncoding. On Unix this
will have PEP383 roundtripping behaviour. So if you want openFile' ::
[Byte] -  IO Handle you can write something like this:

escape = map (\b -  if b  128 then chr b else chr (0xEF00 + b))
openFile = openFile' . escape

The bytes that reach the API call will be exactly the ones you supply.
(You can also implement escape by just encoding the [Byte] with the
fileSystemEncoding).

Likewise, if you have a String and want to get the [Byte] we decoded
it from, you just need to encode the String again with the
fileSystemEncoding.

If this is not enough for you please let me know, but it seems to me
that it covers all your use cases, without any need to reimplement the
FFI bindings.


This is not enough, since these strings are still being passed through
the potentially (and in 7.2.1, actually) broken path encoder.


I think you might be misunderstanding how the new API works.  Basically, 
imagine a reversible transformation:


  encode :: String - [Word8]
  decode :: [Word8] - String

this transformation is applied in the appropriate direction by the IO 
library to translate filesystem paths into FilePath and vice versa.  No 
information is lost; furthermore you can apply the transformation 
yourself in order to recover the original [Word8] from a String, or to 
inject your own [Word8] file path.


Ok?

All this does is mean that the common case where you want to interpret 
file system paths as text works with no fuss, without breaking anything 
in the case when the file system paths are not actually text.


It would probably be better to have an abstract FilePath type and to 
keep the original bytes, decoding on demand.  But that is a big change 
to the API and would break much more code.  One day we'll do this 
properly; for now we have this, which I think is a pretty reasonble 
compromise.


Cheers,
Simon


___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Records in Haskell

2011-11-07 Thread Claus Reinke
I am unsure which of this list of proposals you are referring to. The 
URL you quote is this

http://hackage.haskell.org/trac/haskell-prime/wiki/FirstClassLabels


That sounds familiar, I think I wrote that when I was younger;-)

but it doesn't seem to actually contain a design, merely some options 
for a design that is implicit.  


Please note that this particular instance of FirstClassLabels was *not*
about record systems themselves (already a hopeless mess of proposals
and preferences back then), but about a feature that would help defining
record systems *in the language*. 

So it only outlines designs for shared type-level labels (two of which 
seemed fairly straightforward, one too open-ended), addressing one 
specific aspect shared by all advanced record systems (though there 
are several systems floating around that do not have first-class labels).


Some years later, I found a work-around for creating shared type-level 
labels, outlined in this message, and implemented as Data.Label:


   Non-atomic atoms for type-level programming
   http://www.haskell.org/pipermail/haskell-cafe/2009-April/059819.html

My Haskell community page, 


   http://community.haskell.org/~claus/

near the bottom, has both my Data.Record and my Data.Label sources.
I don't get to do much Haskell these days, though, so the code might 
need tweaking for recent GHC versions.


Just in case there are any interested parties who have the time and
inclination to take this further;-)

Claus



___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: behaviour change in getDirectoryContents in GHC 7.2?

2011-11-07 Thread John Millikin
On Mon, Nov 7, 2011 at 09:02, Simon Marlow marlo...@gmail.com wrote:
 I think you might be misunderstanding how the new API works.  Basically,
 imagine a reversible transformation:

  encode :: String - [Word8]
  decode :: [Word8] - String

 this transformation is applied in the appropriate direction by the IO
 library to translate filesystem paths into FilePath and vice versa.  No
 information is lost; furthermore you can apply the transformation yourself
 in order to recover the original [Word8] from a String, or to inject your
 own [Word8] file path.

 Ok?

I understand how the API is intended / designed to work; however, the
implementation does not actually do this. My argument is that this
transformation should be in a high-level library like directory, and
the low-level libraries like base or unix ought to provide
functions which do not transform their inputs. That way, when an error
is found in the encoding logic, it can be fixed by just pushing a new
version of the affected library to Hackage, instead of requiring a new
version of the compiler.

I am also not convinced that it is possible to correctly implement
either of these functions if their behavior is dependent on the user's
locale.

 All this does is mean that the common case where you want to interpret file
 system paths as text works with no fuss, without breaking anything in the
 case when the file system paths are not actually text.

As mentioned earlier in the thread, this behavior is breaking things.
Due to an implementation error, programs compiled with GHC 7.2 on
POSIX systems cannot open files unless their paths also happen to be
valid text according to their locale. It is very difficult to work
around this error, because the paths-are-text logic was placed at a
very low level in the library stack.

 It would probably be better to have an abstract FilePath type and to keep
 the original bytes, decoding on demand.  But that is a big change to the API
 and would break much more code.  One day we'll do this properly; for now we
 have this, which I think is a pretty reasonble compromise.

Please understand, I am not arguing against the existence of this
encoding layer in general. It's a fine idea for a simplistic
high-level filesystem interaction library. But it should be
*optional*, not part of the compiler or base.

As implemented in GHC 7.2, this encoding is a complex and untested
behavior with no escape hatch.

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


RE: GHC 7.2.2 RC 1

2011-11-07 Thread Chris Dornan
Y'all have probably seen this, but I have opened #5607 saying a bit more.

http://hackage.haskell.org/trac/ghc/ticket/5607

Chris

-Original Message-
From: Simon Marlow [mailto:marlo...@gmail.com] 
Sent: 07 November 2011 16:45
To: Chris Dornan
Cc: 'Ian Lynagh'; glasgow-haskell-users@haskell.org; David Terei
Subject: Re: GHC 7.2.2 RC 1

I think we should apply the minimal change to make all packages trusted by
default in 7.2.2.  Any objections?

Cheers,
Simon

On 06/11/2011 16:36, Chris Dornan wrote:
 It's looking good but base is still untrusted out of the box. Is this
right?

 Chris



___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: behaviour change in getDirectoryContents in GHC 7.2?

2011-11-07 Thread Ian Lynagh
On Mon, Nov 07, 2011 at 05:02:32PM +, Simon Marlow wrote:
 
 Basically, imagine a reversible transformation:
 
   encode :: String - [Word8]
   decode :: [Word8] - String
 
 this transformation is applied in the appropriate direction by the
 IO library to translate filesystem paths into FilePath and vice
 versa.  No information is lost

I think that would be great if it were true, but it isn't:

$ touch `printf '\x80'`
$ touch `printf '\xEE\xBE\x80'`
$ ghc -e 'System.Directory.getDirectoryContents . = print'
[\61312,.,\61312,..]

Both of those filenames get encoded as \61312 (U+EF80).


Thanks
Ian


___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: GHC 7.2.2 RC 1

2011-11-07 Thread David Terei
On 7 November 2011 08:44, Simon Marlow marlo...@gmail.com wrote:
 I think we should apply the minimal change to make all packages trusted by
 default in 7.2.2.  Any objections?

Agreed.

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Records in Haskell

2011-11-07 Thread Wolfgang Jeltsch
Am Montag, den 07.11.2011, 17:53 + schrieb Barney Hilken:
 Here is my understanding of the current state of the argument:
 
 Instead of Labels, there will be a new kind String, which is not a
 subkind of *, so its elements are not types. The elements of String
 are strings at the type level, written just like normal strings. If
 you want labels, you can define them yourself, either empty:
 
   data Label (a :: String)
 
 or inhabited
 
   data Label (a :: String) = Label
 
 these definitions give you a family of types of the form Label name,
 in the first case empty (except for undefined), in the second case
 inhabited by a single element (Label :: Label name)

 There are several similar proposals for extensible records defined
 using labels, all of which (as far as I can see) could be defined just
 as easily using the kind String.

The problem with this approach is that different labels do not have
different representations at the value level. In my record system, I use
label definitions like the following ones:

data MyName1 = MyName1

data MyName2 = MyName2

This allows me to pattern match records, since I can construct record
patterns that contain fixed labels:

X : MyName1 := myValue1 : MyName2 := myValue2

I cannot see how this could be done using kind String. Do you see a
solution for this?

A similar problem arises when you want to define a selector function.
You could implement a function get that receives a record and a label as
arguments. However, you could not say something like the following then:

get myRecord MyName1

Instead, you would have to write something like this:

get myRecord (Label :: MyName1)

Whis is ugly, I’d say.

Yes, Simon’s proposal contains syntactic sugar for selection, but this
sugar might not be available for other record systems, implemented in
the language.

The situation would be different if we would not only have kind String,
but also an automatically defined GADT that we can use to fake dependent
types with string parameters:

data String :: String - *  -- automatically defined

A string literal abc would be of type String abc then. However, I am
not sure at the moment, if this would solve all the above problems.

Best wishes,
Wolfgang


___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Records in Haskell

2011-11-07 Thread Wolfgang Jeltsch
Am Montag, den 07.11.2011, 18:16 +0100 schrieb Claus Reinke:
  I am unsure which of this list of proposals you are referring to. The 
  URL you quote is this
  http://hackage.haskell.org/trac/haskell-prime/wiki/FirstClassLabels
 
 That sounds familiar, I think I wrote that when I was younger;-)
 
  but it doesn't seem to actually contain a design, merely some options 
  for a design that is implicit.  
 
 Please note that this particular instance of FirstClassLabels was *not*
 about record systems themselves (already a hopeless mess of proposals
 and preferences back then), but about a feature that would help defining
 record systems *in the language*. 

Indeed. And I think it is important to make implementing new record
systems in the language easier. Each record system built into the
language might lack some features that someone wants. So it would be
good if one could come up with one’s own record system easily.

Best wishes,
Wolfgang


___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Records in Haskell

2011-11-07 Thread Edward Kmett
On Mon, Nov 7, 2011 at 1:33 PM, Wolfgang Jeltsch g9ks1...@acme.softbase.org
 wrote:

 Am Montag, den 07.11.2011, 18:16 +0100 schrieb Claus Reinke:
   I am unsure which of this list of proposals you are referring to. The
   URL you quote is this
   http://hackage.haskell.org/trac/haskell-prime/wiki/FirstClassLabels
 
  That sounds familiar, I think I wrote that when I was younger;-)
 
   but it doesn't seem to actually contain a design, merely some options
   for a design that is implicit.
 
  Please note that this particular instance of FirstClassLabels was *not*
  about record systems themselves (already a hopeless mess of proposals
  and preferences back then), but about a feature that would help defining
  record systems *in the language*.

 Indeed. And I think it is important to make implementing new record
 systems in the language easier. Each record system built into the
 language might lack some features that someone wants. So it would be
 good if one could come up with one’s own record system easily.


On the other hand, I would rather have one half-way decent record system
that doesn't try to do everything than a bunch of ad hoc incompatible ones.

-Edward
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Records in Haskell

2011-11-07 Thread Barney Hilken

 The problem with this approach is that different labels do not have
 different representations at the value level. 

I think this is an advantage, because it means you don't have to carry this 
stuff about at runtime.

 This allows me to pattern match records, since I can construct record
 patterns that contain fixed labels:
 
X : MyName1 := myValue1 : MyName2 := myValue2
 
 I cannot see how this could be done using kind String. Do you see a
 solution for this?
 
 A similar problem arises when you want to define a selector function.
 You could implement a function get that receives a record and a label as
 arguments. However, you could not say something like the following then:
 
get myRecord MyName1
 
 Instead, you would have to write something like this:
 
get myRecord (Label :: MyName1)

Just define a constant

myName1 = Label :: MyName1

for each label you actually use, and you can use it in both get and pattern 
matching

Barney.


___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Records in Haskell

2011-11-07 Thread Ian Lynagh
On Mon, Nov 07, 2011 at 08:31:04PM +0200, Wolfgang Jeltsch wrote:
 
 The problem with this approach is that different labels do not have
 different representations at the value level. In my record system, I use
 label definitions like the following ones:
 
 data MyName1 = MyName1
 
 data MyName2 = MyName2

Instead of
class Has (r :: *) (f :: String)   (t :: *) where
(as on the wiki), would it be possible to have something like
class Has (r :: *) (ft :: *) (f :: ft) (t :: *) where
(where ft stands for field type)?

This could also solve the representation-hiding problem:

foo.field would use the string field as the field name, as in the
proposal on the wiki page.

But foo.Field (capital first letter) would use the constructor Field
that is in scope. If you don't want to export the field getter then
capitalise the first letter and don't export the constructor.


Thanks
Ian


___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Records in Haskell

2011-11-07 Thread Edward Kmett
Ian said

class Has (r :: *) (ft :: *) (f :: ft) (t :: *) where
 (where ft stands for field type)?


class Has (r :: *) (f :: ft) (t :: *) where

would be my understanding of how it would be phrased under the current
polymorphic kind system.

This could also solve the representation-hiding problem:

 foo.field would use the string field as the field name, as in the
 proposal on the wiki page.

 But foo.Field (capital first letter) would use the constructor Field
 that is in scope. If you don't want to export the field getter then
 capitalise the first letter and don't export the constructor.


I like it. Between that and using Proxy rather than type application
perhaps everyone can be made happy.

-Edward
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


RE: Records in Haskell

2011-11-07 Thread Simon Peyton-Jones
Wolfgang

Is there a wiki page giving a specific, concrete design for the proposal you 
advocate?  Something at the level of detail of 
http://hackage.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields?

I am unsure whether you regard it as an alternative to the above, or something 
that should be done as well.   And if the former, how does it relate to the 
challenge articulated on http://hackage.haskell.org/trac/ghc/wiki/Records, 
namely how to make Haskell's existing named-field system work better?

Thanks

Simon




|  -Original Message-
|  From: glasgow-haskell-users-boun...@haskell.org 
[mailto:glasgow-haskell-users-
|  boun...@haskell.org] On Behalf Of Wolfgang Jeltsch
|  Sent: 07 November 2011 18:31
|  To: glasgow-haskell-users@haskell.org
|  Subject: Re: Records in Haskell
|  
|  Am Montag, den 07.11.2011, 17:53 + schrieb Barney Hilken:
|   Here is my understanding of the current state of the argument:
|  
|   Instead of Labels, there will be a new kind String, which is not a
|   subkind of *, so its elements are not types. The elements of String
|   are strings at the type level, written just like normal strings. If
|   you want labels, you can define them yourself, either empty:
|  
|  data Label (a :: String)
|  
|   or inhabited
|  
|  data Label (a :: String) = Label
|  
|   these definitions give you a family of types of the form Label name,
|   in the first case empty (except for undefined), in the second case
|   inhabited by a single element (Label :: Label name)
|  
|   There are several similar proposals for extensible records defined
|   using labels, all of which (as far as I can see) could be defined just
|   as easily using the kind String.
|  
|  The problem with this approach is that different labels do not have
|  different representations at the value level. In my record system, I use
|  label definitions like the following ones:
|  
|  data MyName1 = MyName1
|  
|  data MyName2 = MyName2
|  
|  This allows me to pattern match records, since I can construct record
|  patterns that contain fixed labels:
|  
|  X : MyName1 := myValue1 : MyName2 := myValue2
|  
|  I cannot see how this could be done using kind String. Do you see a
|  solution for this?
|  
|  A similar problem arises when you want to define a selector function.
|  You could implement a function get that receives a record and a label as
|  arguments. However, you could not say something like the following then:
|  
|  get myRecord MyName1
|  
|  Instead, you would have to write something like this:
|  
|  get myRecord (Label :: MyName1)
|  
|  Whis is ugly, I’d say.
|  
|  Yes, Simon’s proposal contains syntactic sugar for selection, but this
|  sugar might not be available for other record systems, implemented in
|  the language.
|  
|  The situation would be different if we would not only have kind String,
|  but also an automatically defined GADT that we can use to fake dependent
|  types with string parameters:
|  
|  data String :: String - *  -- automatically defined
|  
|  A string literal abc would be of type String abc then. However, I am
|  not sure at the moment, if this would solve all the above problems.
|  
|  Best wishes,
|  Wolfgang
|  
|  
|  ___
|  Glasgow-haskell-users mailing list
|  Glasgow-haskell-users@haskell.org
|  http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: behaviour change in getDirectoryContents in GHC 7.2?

2011-11-07 Thread Yitzchak Gale
Simon Marlow wrote:
 It would probably be better to have an abstract FilePath type and to keep
 the original bytes, decoding on demand.  But that is a big change to the API
 and would break much more code.  One day we'll do this properly; for now we
 have this, which I think is a pretty reasonble compromise.

John Millikin wrote:
 Please understand, I am not arguing against the existence of this
 encoding layer in general. It's a fine idea for a simplistic
 high-level filesystem interaction library. But it should be
 *optional*, not part of the compiler or base.

The problem is that Haskell 98 specifies type FilePath = String.
In retrospect, we now know that this is too simplistic.
But that's what we have right now.

 As implemented in GHC 7.2, this encoding is a complex and untested
 behavior with no escape hatch.

Isn't System.Posix.IO the escape hatch?

Even though FilePath is still used there instead of
ByteString as it should be, this is the
low-level POSIX-specific library. So the old hack of
interpreting the lowest 8 bits as bytes makes
a lot more sense there.

Thanks,
Yitz

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: behaviour change in getDirectoryContents in GHC 7.2?

2011-11-07 Thread John Millikin
On Mon, Nov 7, 2011 at 15:39, Yitzchak Gale g...@sefer.org wrote:
 The problem is that Haskell 98 specifies type FilePath = String.
 In retrospect, we now know that this is too simplistic.
 But that's what we have right now.

This is *a* problem, but not a particularly major one; the definition
of paths in GHC 7.0 (text on some systems, bytes on others) is
inelegant but workable.

The main problem, IMO, is that the semantics of openFile et al changed
in a way that is impossible to check for statically, and there was no
mention of this in the documentation. It's one thing to make a change
which will cause new compilation failures. It's quite another to
introduce an undocumented change in important semantics.

 As implemented in GHC 7.2, this encoding is a complex and untested
 behavior with no escape hatch.

 Isn't System.Posix.IO the escape hatch?

 Even though FilePath is still used there instead of
 ByteString as it should be, this is the
 low-level POSIX-specific library. So the old hack of
 interpreting the lowest 8 bits as bytes makes
 a lot more sense there.

System.Posix.IO, and the unix package in general, also perform the
new path encoding/decoding.

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: GHC 7.2.2 RC 1

2011-11-07 Thread Ian Lynagh
On Mon, Nov 07, 2011 at 01:25:11AM +0400, Kyra wrote:
 On 11/6/2011 5:18 PM, Ian Lynagh wrote:
 7.2.2 will be a minimal bugfix release, fixing only bugs that cannot be
 worked around. Please let us know if you find any showstoppers.
 
 #5531 is still there and no workarounds are known. Also, it's
 specific for post 7.0.Xs.  Not sure if this counts as showstopper,
 though.

We don't have a fix for that yet, so it's very unlikely it'll be fixed
in 7.2.2 (which will be released very soon). But we still have ambitions
to release 7.4.1 later this year!


Thanks
Ian


___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: GHC 7.2.2 RC 1

2011-11-07 Thread Jens Petersen
 We are pleased to announce the first release candidate for GHC 7.2.2:
    http://www.haskell.org/ghc/dist/7.2.2-rc1/

Thanks, I did a test build for Fedora 17 Development.

If you wish to test it on Fedora you can get
the srpm or binary packages from:
http://kojipkgs.fedoraproject.org/scratch/petersen/task_3496432/
(note that F17 is now on a newer major version of gmp
than F16 and earlier, so the binary packages won't install
directly on current releases.)

I am planning to update Fedora 17 Rawhide from 7.0.4 to 7.2.2
when it is released.

Jens

___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users