Re: compiling GHC with a custom path to GCC

2005-02-18 Thread Sven Panne
Remi Turk wrote:
[...] When using the following command-line
CC=gcc3 CXX=g++3 nice ./configure --enable-hopengl --prefix=/var/tmp/ghc 
--with-gcc=/usr/local/bin/gcc3
[...]
Slightly off-topic: You don't need --enable-hopengl anymore when compiling 
GHC 6.4 or the
CVS HEAD, the OpenGL/GLUT/OpenAL packages are automatically enabled when 
autoconf finds the
suitable libraries and headers. If you don't want that, you can use 
--disable-opengl,
--disable-glut and/or --disable-openal.
Cheers,
   S.
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: ghc-cvs-snapshot with wxHaskell

2005-02-18 Thread Daan Leijen
Georg Martius wrote:
Hi,
Patrick and I found some answers to the questions/problems we encountered.
Finally got the thing to work. (patches appended)
Great!
I have a possible fix:
add -odir out/... to the call of ghc -M. This produces correct paths 
for the .o files.
Ok, this makes sense and, importantly, it also works for older ghc's
use grep to filter module A
Problem: the .hi files have still the source path.
Question @Daan: Why do they have to by in out/...? It seams to 
complicate the thing.
Solution: sed
 I fixed that in makefile.lib.
I do not understand what you are saying here. Can you explain in more
detail? What is the issue with .hi files?
The files definitely have to go to out/.. to get everything nicely
separated.
Secondly, maybe ghc should not generate the spurious extra rules?
(and generate exactly what it generated at version 6.2.2). What do
you think Simon?

2. correct import-search path
the make file calls ghc from the wxHaskell-root. Therefore 
-icurrent/source/path has to be included. I fixed that in makefile.
This is weird. It works with ghc-6.2.2, so there should not be an
extra include path. All files are referenced by absolute paths 
everywhere! (that's why I use sed in the first place to process .d files)

3. Package stuff
I included package files in the new style to the configure script.
Problem: the environment variable are not substituted any longer by 
ghc-pkg ?
Simon?
My hack: let configure sustitude the variable, i.e.
configure:750
wxhlibdir=${libdir}
Ok.
Thanks a lot for you hard work on this!
-- Daan.
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: ghc-cvs-snapshot with wxHaskell

2005-02-18 Thread Daan Leijen
The original code in the makefile.lib replaced
(basename input.hs) with (basename output.o)
and
*.hi with *.o
which is a quite weird approach to the problem. I'am not sure but I 
think the new approach is better:
 let the .o files be correct through the -odir flag
replace (dir input)/FILE.hi with (dir output)/$FILE.o
This seems indeed much more sensible. I'll try this out with ghc 6.2.2.
A more general question: We doesn't -ohi dir/filename.hi is not 
reflected in the dependencies.
I tried:

ghc -M -odir out -ohi out/A.hi A.hs
but nothing changed.
Simon??
Thanks again for your bug fixing,
-- Daan.
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Restricted Types and Infinite Loops

2005-02-18 Thread Simon David Foster
On Fri, 2005-02-18 at 02:18 +0100, Ralf Laemmel wrote:

 Here I assume that you don't _really_ depend on ClassB to be a 
 superclass of ClassA. (Why would you?)

Ok, here's what the real class head is (or was before I butchered it to
make it work);

class (Data (DictXMLData h) a, XMLNamespace a) = XMLData h a where

We want to do this so that it is unnecessary to store XML Namespaces in
the XMLData instances (which is supposed to be for only encoding). There
are two reasons why this is necessary;

* 1 - We have another class XSDType a, which gives types an XSD Type.
This also depends on the types having a namespace. If we don't have this
class dependency, we end up with repeated data.
* 2 - In various contexts, you will require a different namespace for a
particular element, but the same encoder. For example, when creating a
SOAP Envelope, the int data-type could have the SOAP Encoding
namespace or it could have the XSD Namespace. Further it may not have a
namespace at all, in which case the default instance (XMLNamespace a)
will take over. By taking the dependency out you bind a particular
namespace to an encoder.

For now, the various encoders for XSD data-types are in the XSD Module,
this means that any user that wants to encode an int or string must
import the XSD module, since we can't centralise the encoder.

 This is a simpler recursion scheme in terrms of class/instance constraints.

Maybe, but sadly it doesn't achieve my goal. I could do Namespaces via a
hook, but that makes the construction and encoding of namespace tables
almost impossible.

Thanks,

-Si.

-- 
Simon David Foster [EMAIL PROTECTED]

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


RE: compiling GHC with a custom path to GCC

2005-02-18 Thread Simon Marlow
On 18 February 2005 01:02, Donald Bruce Stewart wrote:

 This is a known problem with gcc-2.95.
 We came across it back in September.
 
 It was noticed in the nightly builds:

 http://www.haskell.org/pipermail/cvs-all/2004-September/035116.html 
 
 And then we chased it up:
  
 http://www.haskell.org/pipermail/cvs-all/2004-September/035122.html
 http://www.haskell.org/pipermail/cvs-all/2004-September/035134.html
 http://www.haskell.org/pipermail/cvs-all/2004-September/035259.html
 http://www.haskell.org/pipermail/cvs-all/2004-September/035268.html
 http://www.haskell.org/pipermail/cvs-all/2004-September/035293.html  

Don, thanks for the pointer, I'd completely forgotten about that.

I think I'll be able to install a workaround for 6.4 based on the gcc
version.  I need it at least because FreeBSD 4.x still uses gcc 2.95,
and AFAIK quite a few folks are still using that platform.

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


RE: compiling GHC with a custom path to GCC

2005-02-18 Thread Simon Marlow
On 18 February 2005 09:38, Remi Turk wrote:

 On Thu, Feb 17, 2005 at 11:29:41AM -, Simon Marlow wrote:
 I've noticed gcc 2.95 crashing on my FreeBSD box too.  I should
 look into whether there's a workaround, otherwise we're hosed on
 FreeBSD 4.x. 
 
 (though I now assume it probably isn't even the same bug?)

Yes, it's the same bug.

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


Re: Restricted Types and Infinite Loops

2005-02-18 Thread Keean Schupke
I seem to remember that if you define the class:
class DictXMLData h = XMLData h ...
instance (Data d a,XMLNamespace a) = XMLData d where ...
then providing you annotate the instance functions with the relavent
scoped type variables (d and a) then the compiler will infer XMLNamespace
correctly for those instances that use it from the XMLData constraint.
   Keean.
Simon David Foster wrote:
On Fri, 2005-02-18 at 02:18 +0100, Ralf Laemmel wrote:
 

Here I assume that you don't _really_ depend on ClassB to be a 
superclass of ClassA. (Why would you?)
   

Ok, here's what the real class head is (or was before I butchered it to
make it work);
class (Data (DictXMLData h) a, XMLNamespace a) = XMLData h a where
We want to do this so that it is unnecessary to store XML Namespaces in
the XMLData instances (which is supposed to be for only encoding). There
are two reasons why this is necessary;
* 1 - We have another class XSDType a, which gives types an XSD Type.
This also depends on the types having a namespace. If we don't have this
class dependency, we end up with repeated data.
* 2 - In various contexts, you will require a different namespace for a
particular element, but the same encoder. For example, when creating a
SOAP Envelope, the int data-type could have the SOAP Encoding
namespace or it could have the XSD Namespace. Further it may not have a
namespace at all, in which case the default instance (XMLNamespace a)
will take over. By taking the dependency out you bind a particular
namespace to an encoder.
For now, the various encoders for XSD data-types are in the XSD Module,
this means that any user that wants to encode an int or string must
import the XSD module, since we can't centralise the encoder.
 

This is a simpler recursion scheme in terrms of class/instance constraints.
   

Maybe, but sadly it doesn't achieve my goal. I could do Namespaces via a
hook, but that makes the construction and encoding of namespace tables
almost impossible.
Thanks,
-Si.
 

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


Re: Restricted Types and Infinite Loops

2005-02-18 Thread Keean Schupke
Having looked at some of my source code this relies on Data having a
functional dependancy such that:
   class Data d a | d - a ...
So it might not work for what you want.
   Keean.
Keean Schupke wrote:
I seem to remember that if you define the class:
class DictXMLData h = XMLData h ...
instance (Data d a,XMLNamespace a) = XMLData d where ...
then providing you annotate the instance functions with the relavent
scoped type variables (d and a) then the compiler will infer XMLNamespace
correctly for those instances that use it from the XMLData constraint.
   Keean.
Simon David Foster wrote:
On Fri, 2005-02-18 at 02:18 +0100, Ralf Laemmel wrote:
 

Here I assume that you don't _really_ depend on ClassB to be a 
superclass of ClassA. (Why would you?)
  

Ok, here's what the real class head is (or was before I butchered it to
make it work);
class (Data (DictXMLData h) a, XMLNamespace a) = XMLData h a where
We want to do this so that it is unnecessary to store XML Namespaces in
the XMLData instances (which is supposed to be for only encoding). There
are two reasons why this is necessary;
* 1 - We have another class XSDType a, which gives types an XSD Type.
This also depends on the types having a namespace. If we don't have this
class dependency, we end up with repeated data.
* 2 - In various contexts, you will require a different namespace for a
particular element, but the same encoder. For example, when creating a
SOAP Envelope, the int data-type could have the SOAP Encoding
namespace or it could have the XSD Namespace. Further it may not have a
namespace at all, in which case the default instance (XMLNamespace a)
will take over. By taking the dependency out you bind a particular
namespace to an encoder.
For now, the various encoders for XSD data-types are in the XSD Module,
this means that any user that wants to encode an int or string must
import the XSD module, since we can't centralise the encoder.
 

This is a simpler recursion scheme in terrms of class/instance 
constraints.
  

Maybe, but sadly it doesn't achieve my goal. I could do Namespaces via a
hook, but that makes the construction and encoding of namespace tables
almost impossible.
Thanks,
-Si.
 

___
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: Restricted Types and Infinite Loops [SOLVED, I think]

2005-02-18 Thread Simon David Foster
Whoops, I should have tried it first. Amazingly, this seems to works.
But I'm not sure I understand why, a still depends on XMLNamespace,
because of the dictionary instance;

instance (Data (DictXMLData b) a, XMLHook b a, XMLData b a, XMLNamespace
a) = Sat (DictXMLData b a) where

But I guess it's because the dependency on XMLNamespace comes in the
instances, rather than the class head.

-Si.

-- 
Simon David Foster [EMAIL PROTECTED]

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


Re: compiling GHC with a custom path to GCC

2005-02-18 Thread Seth Kurtzberg




Simon Marlow wrote:

  On 18 February 2005 04:26, Seth Kurtzberg wrote:

  
  
At least this proves that it isn't a hardware problem.  :)

  
  
Seth, you're a bit confused.  This error from gcc is a deterministic,
repeatable, crash due to a known bug in gcc 2.95.  

You were complaining about random unrepeatable crashes, which are most
likely caused by hardware failure.  We never said that deterministic
crashes in gcc are due to hardware.

Cheers,
	Simon
  

Simon, you'll never give up. The crashes are absolutely repeatable.
The fact that I haven't identified a deterministic way to reproduce
them does not in any way imply that a deterministic way to reproduce
them does not exist. And, as I've said, you are essentially claiming
that a total of over 100 machines all have the same hardware problem,
that never ever occurs unless gcc is running. You know that isn't
true. You can, on the same machines, compile the same code with a
different compiler hundreds of times (which I did; I left it running on
two machines for a month) without a single problem. That is a software
problem.

I make a living by determining whether problems are software or
hardware, and I very rarely make a mistake. I certainly never make a
mistake with this sort of overwhelming proof. You are just ignoring
the things that I've said that don't fit your theory. You will not
find a single case of this caused by hardware, because if the hardware
is really responsible, it is 100% impossible that every other program,
including programs that consume all the memory and most of the swap
(consume more total memory than the gcc runs) always work perfectly,
and only gcc causes this supposedly hardware problem to appear. 100
machines, of six different microprocessors, and six different types of
memory, all have a hardware problem that causes gcc, and only gcc, and
absolutely nothing other than gcc, to crash? These machines can
otherwise run for months at a time at very high load and the hardware
problem somehow never appears?

Tell me that you've ever seen a hardware problem with these
characteristics. Furthermore, tell me that you've seen hardware
problems that never get worse, and are associated with a single
program. Find a single example of such a program that reveals a
hardware problem in processors made by three different companies. Or
an example of a program that reveals a hardware problem in a dozen
different motherboards. None of which exhibit even the slightest
problem unless gcc is running. None of which deadlock, freeze up,
never have kernel panics ... it just isn't possible, unless you ignore
the evidence.

And the fact that one is deterministic implies that the others are
not? That has absolutely no basis in logic. I'm sure that with enough
work each and every one can be produce deterministically. Nobody has
paid me to do that, and nobody is going to. It's a lot cheaper to just
use a compiler that works. Even having to use Sun's compiler, with all
it's problems, is less expensive then trying to fix gcc, and Sun
charges about 3,000 each for the compiler.

Hardware problems cause random problems, and any problem that occurs
with only one program is by definition not random. You are confusing
random with not yet explained. The two aren't remotely alike.

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

!DSPAM:4215baf2198669959829382!

  




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


Re: compiling GHC with a custom path to GCC

2005-02-18 Thread Malcolm Wallace
Seth Kurtzberg [EMAIL PROTECTED] writes:

 Simon, you'll never give up.  The crashes are absolutely repeatable.  
 The fact that I haven't identified a deterministic way to reproduce them 
 does not in any way imply that a deterministic way to reproduce them 
 does not exist.  And, as I've said, you are essentially claiming that a 
 total of over 100 machines all have the same hardware problem, that 
 never ever occurs unless gcc is running.  You know that isn't true.  You 
 can, on the same machines, compile the same code with a different 
 compiler hundreds of times (which I did; I left it running on two 
 machines for a month) without a single problem.  That is a software problem.

OK, calm down.  I, for one, suggested the possibility of a hardware
fault because your original message on the subject of gcc crashes did
not mention the possibility at all, and I thought perhaps it was a
factor you had not considered.  Obviously you have indeed considered it
in quite some detail, and concluded that hardware is not a factor here.
But because we didn't know that, the suggestion was intended to help you
explore new avenues to tracking down the fault, not to annoy you.

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


RE: ghc-cvs-snapshot with wxHaskell

2005-02-18 Thread Simon Marlow
On 17 February 2005 20:24, Georg Martius wrote:

 2. Stub files (@Simon)
 The problem I ran into was that the FILE_stub.o files are not placed
 at the correct(?) directory according to the position of FILE in the
 hierarchical library.  
 Example:
 ghc -c wxcore/src/Graphics/UI/WXCore/Events.hs -o
 out/wxcore/imports/Graphics/UI/WXCore/Events.o  -fvia-C -package-name
 wxcore -iwxcore/src -odir out/wxcore/imports -hidir
 out/wxcore/imports -iout/wxcore/imports -Iwxc/include   
 
 produces
   out/wxcore/imports/Events_stub.o
 instead of
   out/wxcore/imports/Graphics/UI/WXCore/Events_stub.o
 I don't know if it is the expected behaviour?

I just looked at the code, this is a can of worms.  I don't think I can
fix it this close to the release without breaking anything else, so if
you can manage with this behaviour then I'll leave it as is.  

Later, we can try to determine what the right behaviour should be with
respect to stub files and the interactions with --make, hierarchical
modules and -odir.  Right now it's making my head hurt a bit.
 
Cheers,
Simon
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


RE: compiling GHC with a custom path to GCC

2005-02-18 Thread Simon Marlow
On 18 February 2005 10:17, Seth Kurtzberg wrote:

 Simon, you'll never give up.  The crashes are absolutely repeatable. 
 The fact that I haven't identified a deterministic way to reproduce
 them does not in any way imply that a deterministic way to reproduce
 them does not exist.  And, as I've said, you are essentially claiming
 that a total of over 100 machines all have the same hardware problem,
 that never ever occurs unless gcc is running.

I'm not *claiming* anything about your case - please read what I said.
I simply commented that random crashes in gcc are often caused by
hardware failure.  Indeed it sounds like hardware isn't the problem in
your case, so I suggest you try to narrow down the problem and submit a
report to the gcc folks.

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


library path problem

2005-02-18 Thread Akos Korosmezey
When I compile a simple code importing Control.Monad.State with 
ghc-6.4.20050217 on Linux I get linking errors:

% cat foo.hs
import Control.Monad.State
main = putStr Hello\n
% ghc foo.hs
foo.o(.text+0x145): In function `__stginit_Main_':
: undefined reference to `__stginit_ControlziMonadziState_'
collect2: ld returned 1 exit status
%
The same works with the --make option:
% ghc --make foo.hs
Chasing modules from: foo.hs
Compiling Main ( foo.hs, foo.o )
Linking ...
%
I tried both the linux binary and to compile GHC from source.
Akos
--
~
Akos Korosmezey Tel:+36-1-439-5936
Ericsson Telecom Ltd. ETH/GSCD/RUNB Fax:+36-1-437-7576
P.O.B. 107, H-1300 Budapest, HungaryHome:   +36-26-342-687
mailto:[EMAIL PROTECTED] Mobile: +36-30-740-7732
~
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: library path problem

2005-02-18 Thread Sven Panne
Akos Korosmezey wrote:
When I compile a simple code importing Control.Monad.State with 
ghc-6.4.20050217 on Linux I get linking errors:  [...]
You have to use -package mtl when --make is not used, because mtl (where
Control.Monad.State resides) is not an auto package, for more details see:
   http://haskell.org/ghc/docs/latest/html/users_guide/packages.html
Cheers,
   S.
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


gunfoldl

2005-02-18 Thread Akos Korosmezey
I wrote a little data structure with quantified constructors:
module MyModule where
  import Data.Generics
  import Data.HashTable
  data Item = forall a. (Data a) = Leaf Bool a
| forall a. (Data a) = Branch Bool a Int Int
 
deriving (Typeable)

I want it to make an instance of Data:
  instance Data Item where
  gfoldl k z (Leaf b v) = z (Leaf b) `k` v
  gfoldl k z (Branch b v a1 a2) = z (\x - Branch b x a1 a2) `k` v
  --gunfoldl k z c = case constrIndex c of
  --1 - k z (Leaf undefined 
undefined)
  toConstr (Leaf _ _) = leafConstr
  toConstr (Branch _ _ _ _) = branchConstr
  dataTypeOf _ = itemDataType

  itemDataType = mkDataType Subliminal.Item [leafConstr, branchConstr]
  leafConstr = mkConstr itemDataType Leaf [] Prefix
  branchConstr = mkConstr itemDataType Branch [] Prefix
But, when I try to compile it with ghc-6.4-20050217:
ghc -fglasgow-exts -i. -c kicsi.hs
kicsi.hs:13:4:
  Warning: No explicit method nor default method for `gunfold'
   In the instance declaration for `Data Item'
ghc-6.4.20050217: panic! (the `impossible' happened, GHC version 
6.4.20050217):
  cgPanic
  k{v a1vu}
  static binds for:
  local binds for:
  gunfold{v r22q}
  SRT labelghc-6.4.20050217: panic! (the `impossible' happened, GHC 
version 6.4.20050217):
  initC: srt

Please report it as a compiler bug to glasgow-haskell-bugs@haskell.org,
or http://sourceforge.net/projects/ghc/.
If I uncomment the gunfoldl lines:
ghc -fglasgow-exts -i. -c kicsi.hs
kicsi.hs:12:8: `gunfoldl' is not a (visible) method of class `Data'
Compilation exited abnormally with code 1 at Fri Feb 18 20:55:32
Could you please help me?
Thanks
Akos
--
~
Akos Korosmezey Tel:+36-1-439-5936
Ericsson Telecom Ltd. ETH/GSCD/RUNB Fax:+36-1-437-7576
P.O.B. 107, H-1300 Budapest, HungaryHome:   +36-26-342-687
mailto:[EMAIL PROTECTED] Mobile: +36-30-740-7732
~
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Restricted Types and Infinite Loops

2005-02-18 Thread Ralf Laemmel
Hi Simon (PJ),
cc Simon (DF),
I rather reckon we are facing a bug here.
The attached minimalised Foo.hs shows the offending code pattern.
With GHC 6.2 we get *** Exception: loop
With GHC 6.4 we get(still waiting for the rest of the string)
The scenario is about class/instance-head-level recursion
through superclassing and instance constraints.
Nothing too weird.
There are no _explicit_ recursive dictionaries.
An observations though.
The relevant class head does not just mention a recursive superclass,
but also an innocent superclass ClassB. If we move this innocent
superclass constraint to the instance level (see Bar.hs), then
we get termination with both 6,2 and 6.4.
Another issue.
This feature seems to need multi-parameter classes really!
Ralf
Simon Peyton-Jones wrote:
Simon
You've found an interesting case. 

First, you are skating on thin ice here.  GHC's ability to build
recursive dictionaries is quite experimental, and you are relying on it
completely.  

But you're right: it should work.  I can see why it isn't but I have
not got it clear enough in my head to know the best way to fix it.
Still less do I have a formal story about what should type-check
(without loops) and what should not.
So this is going to continue to fail in 6.4, but it's on my list to look
at.
Simon
 

--
Ralf Lammel
[EMAIL PROTECTED]
Microsoft Corp., Redmond, Webdata/XML
http://www.cs.vu.nl/~ralf/
{-# OPTIONS -fglasgow-exts -fallow-undecidable-instances #-}

{-

Try:

(sat::Int - String - String) undefined hello

-}


module Foo where

class (Sat (a - b - String), ClassB b) = ClassA a b

class ClassB a
 where
  fun :: a - String

class Sat x
 where
   sat :: x

instance ClassA a b = Sat (a - b - String)
 where
  sat = const fun

instance ClassA a String

instance ClassB String
 where
  fun = id
{-# OPTIONS -fglasgow-exts -fallow-undecidable-instances #-}

{-

Try:

(sat::Int - String - String) undefined hello

-}


module Foo where

class Sat (a - b - String) = ClassA a b

class ClassB a
 where
  fun :: a - String

class Sat x
 where
   sat :: x

instance (ClassA a b, ClassB b) = Sat (a - b - String)
 where
  sat = const fun

instance ClassA a String

instance ClassB String
 where
  fun = id
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: gunfoldl

2005-02-18 Thread Ralf Laemmel
It is called gunfold rather than gunfoldl
as you will see when you browse the Data.Generics.Basics.
Also, your gunfold code looks like it will not work.
Here is a simple example for Maybe:
   gunfold k z con   =
 case constrIndex con of
   1 - z Nothing  -- no children
   2 - k (z Just) -- one child, hence one k
Bottom line:
- apply z to the Constructor
- apply k as many times as the number of children.
No warranty that this is easy for your type Item.
Good luck,
Ralf
Akos Korosmezey wrote:
I wrote a little data structure with quantified constructors:
module MyModule where
  import Data.Generics
  import Data.HashTable
  data Item = forall a. (Data a) = Leaf Bool a
| forall a. (Data a) = Branch Bool a Int Int
 
deriving (Typeable)

I want it to make an instance of Data:
  instance Data Item where
  gfoldl k z (Leaf b v) = z (Leaf b) `k` v
  gfoldl k z (Branch b v a1 a2) = z (\x - Branch b x a1 a2) `k` v
  --gunfoldl k z c = case constrIndex c of
  --1 - k z (Leaf undefined 
undefined)
  toConstr (Leaf _ _) = leafConstr
  toConstr (Branch _ _ _ _) = branchConstr
  dataTypeOf _ = itemDataType

  itemDataType = mkDataType Subliminal.Item [leafConstr, branchConstr]
  leafConstr = mkConstr itemDataType Leaf [] Prefix
  branchConstr = mkConstr itemDataType Branch [] Prefix
But, when I try to compile it with ghc-6.4-20050217:
ghc -fglasgow-exts -i. -c kicsi.hs
kicsi.hs:13:4:
  Warning: No explicit method nor default method for `gunfold'
   In the instance declaration for `Data Item'
ghc-6.4.20050217: panic! (the `impossible' happened, GHC version 
6.4.20050217):
  cgPanic
  k{v a1vu}
  static binds for:
  local binds for:
  gunfold{v r22q}
  SRT labelghc-6.4.20050217: panic! (the `impossible' happened, GHC 
version 6.4.20050217):
  initC: srt

Please report it as a compiler bug to glasgow-haskell-bugs@haskell.org,
or http://sourceforge.net/projects/ghc/.
If I uncomment the gunfoldl lines:
ghc -fglasgow-exts -i. -c kicsi.hs
kicsi.hs:12:8: `gunfoldl' is not a (visible) method of class `Data'
Compilation exited abnormally with code 1 at Fri Feb 18 20:55:32
Could you please help me?
Thanks
Akos

--
Ralf Lammel
[EMAIL PROTECTED]
Microsoft Corp., Redmond, Webdata/XML
http://www.cs.vu.nl/~ralf/
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


schedule: re-entered unsafely - with heavy concurrent load

2005-02-18 Thread Einar Karttunen
Hello

I am having problems with the threaded rts (6.5.20050207)
dying with 'schedule: re-entered unsafely'. The same code 
seems to work with 6.2.2 with threaded rts.

The exact error message is:
foo: schedule: re-entered unsafely.
   Perhaps a 'foreign import unsafe' should be 'safe'?

I originally notices the problem with networking code which 
didn't use any of Network (nor threadWaitX). However the error 
appeared even with the standard libraries tipping in the direction 
of a bug in the rts.

The code works most of the time, but has a small probability of 
failing when load is high. The test case implements a dummy web 
server which can be tried with e.g. apache benchmark (ab),
/usr/sbin/ab2 -c 1000 -n 5000 127.0.0.1:8080/foo
usually crashes the code when run a few times.
The code should be compiled and run as 
ghc --make -threaded foo.hs -o foo  ./foo 8080

import Network
import Control.Concurrent
import qualified Control.Exception as E
import System
import System.IO

main = do [port] - getArgs
  server port

server port = do
  s - listenOn $ PortNumber $ fromIntegral $ read port
  acceptLoop s

acceptLoop sock = do
  (csock,_,_) - accept sock
  forkIO (handle csock `E.catch` print)
  acceptLoop sock

handle sock = do
  hPutStr sock HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\n\r\n
  hPutStr sock (This is the body for the request to\n++hope you like 
this.\n\nnow garbage:\n)
  hClose sock


- Einar Karttunen

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


RE: schedule: re-entered unsafely - with heavy concurrent load

2005-02-18 Thread Simon Marlow
On 18 February 2005 22:15, Einar Karttunen wrote:

 I am having problems with the threaded rts (6.5.20050207)
 dying with 'schedule: re-entered unsafely'. The same code
 seems to work with 6.2.2 with threaded rts.
 
 The exact error message is:
 foo: schedule: re-entered unsafely.
Perhaps a 'foreign import unsafe' should be 'safe'?

I fixed a bug that might cause this in the last couple of days.  Could
you try again with a fresh build and let us know if the problem still
occurs?

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


Re: GHC 6.4 release candidates available

2005-02-18 Thread Josef Svenningsson
Hi,

Compiling 6.4.20050217 on Windows according to the book fails pretty early:
snippet
/cygdrive/c/ghc/ghc-6.2.2/bin//ghc -H16m -O -I. -Rghc-timing  -I../../../librari
es -fglasgow-exts -no-recomp-c Compat/RawSystem.hs -o Compat/RawSystem.o  -o
hi Compat/RawSystem.hi
c:/DOCUME~1/JOSEFS~1/LOKALA~1/Temp/ghc3868.hc: In function `s3SQ_entry':
c:/DOCUME~1/JOSEFS~1/LOKALA~1/Temp/ghc3868.hc:109: too many arguments to functio
n `rawSystem'
/snippet

Cheers,

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


Re: compiling GHC with a custom path to GCC

2005-02-18 Thread Seth Kurtzberg




Simon Marlow wrote:

  On 18 February 2005 10:17, Seth Kurtzberg wrote:

  
  
Simon, you'll never give up.  The crashes are absolutely repeatable. 
The fact that I haven't identified a deterministic way to reproduce
them does not in any way imply that a deterministic way to reproduce
them does not exist.  And, as I've said, you are essentially claiming
that a total of over 100 machines all have the same hardware problem,
that never ever occurs unless gcc is running.

  
  
I'm not *claiming* anything about your case - please read what I said.
I simply commented that random crashes in gcc are often caused by
hardware failure.  Indeed it sounds like hardware isn't the problem in
your case, so I suggest you try to narrow down the problem and submit a
report to the gcc folks.

Cheers,
	Simon
  

The gcc folks know about the problem, they just don't know how to fix
it. I've sent them about 30 core files and many valgrind runs showing
heap corruption.

I have actually never seen a random crash in gcc, with a coherent core
dump file, caused by hardware. This is much much too regular to even
suspect hardware.

You also have the fact that these machines can run ghc or ghci all day
long. ghc is a heavier user of resources, and a much more complex
program, but it never crashes these systems (except occasionally during
these initial release or pre-release periods, which is of course to be
expected). _If_ a random crash were caused by hardware, other programs
would _always_ occasionally crash. There are no exceptions to this
rule, unless you never run any program other than gcc that uses
significant resources (and even then I'd be dubious).

It's been happening for so long, and the gcc people have no concept of
what's happening, so people don't even bother to report it anymore.
Gcc 3.1 and 3.2 were simply rejected by almost all users because of the
frequency of crashes. With 3.3, the crashes did not disappear, but
became less common. The initial 3.4 release was unusable. All of
these things are well known to anyone working on a C++ project.

I would think that, in addition to showing the ghc is a far superior
piece of software, the fact that ghc or ghci, once built, never crashes
would eliminate any doubt about whether the problem is caused by
hardware or software.

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

!DSPAM:4215dcff207641880317564!

  




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