Error compiling ghc-0.8.1 in Red Hat Linux 7.0

2000-10-06 Thread José Romildo Malaquias

Hello.

When trying to rebuild the GHC rpms distributed by Manuel
M. T. Chakravarty, I got some errors:

-
[...]
../driver/ghc-inplace -I../includes -I. -Iparallel -optc-Wall  -optc-W -optc-Wst
rict-prototypes  -optc-Wmissing-prototypes  -optc-Wmissing-declarations -optc-Wi
nline -optc-Waggregate-return -optc-Wpointer-arith -optc-Wbad-function-cast -O2 
-optc-DCOMPILING_RTS -static-c Exception.hc -o Exception.o -osuf o
Prologue junk?: .globl blockAsyncExceptionszh_fast
blockAsyncExceptionszh_fast:
subl$12, %esp

make[2]: *** [Exception.o] Error 255
make[1]: *** [all] Error 1
make: *** [all] Error 1
-

Then I have tried the older GCC compiler (kgcc, which is really
egcs-2.91.66) distributed by Red Hat in order to compile the
Linux kernel (as the default GCC, 2.96, is not suitable for that),
with no success:

-
[...]

==fptools== make all - --no-print-directory -r;
 in /home/romildo/rpms/BUILD/fptools/ghc/compiler

/usr/bin/ghc -cpp -fglasgow-exts -Rghc-timing -I. -IcodeGen -InativeGen -Iparser 
-iutils:basicTypes:types:hsSyn:prelude:rename:typecheck:deSugar:coreSyn:specialise:simplCore:stranal:stgSyn:simplStg:codeGen:absCSyn:main:profiling:parser:usageSP:cprAnalysis:javaGen:nativeGen
 -recomp -O  -fvia-C -monly-3-regs -optC-funfolding-interface-threshold7  -c 
utils/PrimPacked.lhs -o utils/PrimPacked.o -osuf o
<>
Prologue junk?: .globl __init_PrimPacked
__init_PrimPacked:
subl$12, %esp

make[2]: *** [utils/PrimPacked.o] Error 255
make[1]: *** [all] Error 1
make: *** [all] Error 1
-

Any hints?

Romildo
-- 
Prof. José Romildo Malaquias <[EMAIL PROTECTED]>
Departamento de Computação
Universidade Federal de Ouro Preto
Brasil

___
Glasgow-haskell-bugs mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs



RE: Bug report

2000-10-06 Thread Simon Peyton-Jones

Axel

Quite right; thank you for reporting it.  The fix was trivial, but 
we're not planning 4.08.2 for a while (if ever).  So a workaround is to
write
import PrelIOBase
foo = returnIO

in your module. Or have at least one 'foreign export dynamic' in your
module.

Simon

| -Original Message-
| From: Axel Krauth [mailto:[EMAIL PROTECTED]]
| Sent: 05 October 2000 16:19
| To: [EMAIL PROTECTED]
| Subject: Bug report
| 
| 
| -- Sorry, but if ghc tells me to report it..
| --
| -- Using :The Glorious Glasgow Haskell Compilation System, 
| version 4.08.1
| -- (if this is also needed) : gcc 2.95.2 ( also egcs 1.1.2)
| -- ghc -v -fglasgow-exts -i/usr/local/lib/ghc-4.08.1/imports/lang/  \
| -- -o bug bug.hs -lHSlang 
| --
| -- message by ghc (ghc -v in attachment) : 
| --  panic! (the `impossible' happened):
| --tcLookupGlobalValue: .PrelIOBase.returnIO{-0B,s-}
| --Please report it as a compiler bug to 
| [EMAIL PROTECTED]
| 
| module Main where
| 
| import Foreign
| 
| foreign export ccall "gccd" mygcd :: Int -> Int -> Int 
| main =
| do
| putStrLn "No bug"
| 
| mygcd  a b = if (a==b) then a 
|   else if (ahttp://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs



FW: type of stToIO

2000-10-06 Thread Simon Peyton-Jones

Ross

Your example below isn't very compelling (i.e. I wouldn't mind
losing the expressive power you exploit).  And something in me
dislikes the idea of exposing RealWorld as a type to the programmer.

I don't know a technical basis for making this choice.  I wonder what
John thinks.

Simon


-Original Message-
From: Ross Paterson [mailto:[EMAIL PROTECTED]]
Sent: 05 October 2000 18:24
To: Simon Peyton-Jones
Cc: [EMAIL PROTECTED]
Subject: Re: type of stToIO


On Thu, Oct 05, 2000 at 09:25:18AM -0700, Simon Peyton-Jones wrote:
| | The library documentation says
| | 
| | stToIO :: ST s a -> IO a
| | 
| | but PrelIOBase says
| | 
| | stToIO :: ST RealWorld a -> IO a
| | 
| | The documented type would be unsafe (as it is in Classic Hugs), so it
| | seems necessary to mention the real world in the documentation.
| 
| I discussed this with John Launchbury who pointed out a much
| better type for stToIO
| 
|   stToIO :: (forall s. ST s a) -> IO a
| 
| That avoids exposing RealWorld while preserving soundness.  Better, eh?

I'm not so sure.  The current type (in GHC) means something: the IO
monad ensures sequential access to its own region of the heap (though
maybe RealWorld isn't the best name for this).  And it's more general,
e.g. I can write

> data Var v = Var { readVar :: IO v, writeVar :: v -> IO () }

> newVar :: v -> IO (Var v)
> newVar v = stToIO $ do
>   r <- newSTRef v
>   return (Var {
>   readVar = stToIO (readSTRef r),
>   writeVar = stToIO . writeSTRef r
>   })

which would be forbidden by the John's runST-style type.

___
Glasgow-haskell-bugs mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs

___
Glasgow-haskell-bugs mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs



RE: type of stToIO

2000-10-06 Thread Simon Marlow

John's stToIO could be implemented in terms of runST, like so:

stToIO :: (forall s . ST s a) -> IO a
stToIO st = return (runST st)

maybe you want strictness here (i.e. applying seq to the result of runST
before returning), maybe not.  I'm sure there are arguments both ways.

GHC's stToIO currently has a different meaning: it embeds the ST computation
into the I/O monad, using the fact that IO is an instance of ST.  Or in
other words, IO is just one distinguished state thread, which we're calling
RealWorld.  It seems to me that embedding ST computations in the IO monad is
entirely reasonable, potentially useful, and we shouldn't disallow it on the
grounds that it exposes RealWorld to the programmer.  RealWorld is just an
abstract placeholder after all.

Cheers,
Simon

> Ross
> 
> Your example below isn't very compelling (i.e. I wouldn't mind
> losing the expressive power you exploit).  And something in me
> dislikes the idea of exposing RealWorld as a type to the programmer.
> 
> I don't know a technical basis for making this choice.  I wonder what
> John thinks.
> 
> Simon
> 
> 
> -Original Message-
> From: Ross Paterson [mailto:[EMAIL PROTECTED]]
> Sent: 05 October 2000 18:24
> To: Simon Peyton-Jones
> Cc: [EMAIL PROTECTED]
> Subject: Re: type of stToIO
> 
> 
> On Thu, Oct 05, 2000 at 09:25:18AM -0700, Simon Peyton-Jones wrote:
> | | The library documentation says
> | | 
> | |   stToIO :: ST s a -> IO a
> | | 
> | | but PrelIOBase says
> | | 
> | |   stToIO :: ST RealWorld a -> IO a
> | | 
> | | The documented type would be unsafe (as it is in Classic 
> Hugs), so it
> | | seems necessary to mention the real world in the documentation.
> | 
> | I discussed this with John Launchbury who pointed out a much
> | better type for stToIO
> | 
> | stToIO :: (forall s. ST s a) -> IO a
> | 
> | That avoids exposing RealWorld while preserving soundness.  
> Better, eh?
> 
> I'm not so sure.  The current type (in GHC) means something: the IO
> monad ensures sequential access to its own region of the heap (though
> maybe RealWorld isn't the best name for this).  And it's more general,
> e.g. I can write
> 
> > data Var v = Var { readVar :: IO v, writeVar :: v -> IO () }
> 
> > newVar :: v -> IO (Var v)
> > newVar v = stToIO $ do
> > r <- newSTRef v
> > return (Var {
> > readVar = stToIO (readSTRef r),
> > writeVar = stToIO . writeSTRef r
> > })
> 
> which would be forbidden by the John's runST-style type.
> 
> ___
> Glasgow-haskell-bugs mailing list
> [EMAIL PROTECTED]
> http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs
> 
> ___
> Glasgow-haskell-bugs mailing list
> [EMAIL PROTECTED]
> http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs
> 

___
Glasgow-haskell-bugs mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs



Re: FW: type of stToIO

2000-10-06 Thread Ross Paterson

On Fri, Oct 06, 2000 at 02:15:17AM -0700, Simon Peyton-Jones wrote:
: Your example below isn't very compelling (i.e. I wouldn't mind
: losing the expressive power you exploit).  And something in me
: dislikes the idea of exposing RealWorld as a type to the programmer.

I guess my example isn't compelling because you have already added mutable
variables to the IO monad.  And would you feel less queasy if it were
called something like MainStore?  After all, it refers to a region of
the heap, rather than the full IO environment.  With a primitive

> stToIO :: ST MainStore a -> IO a

we could define

> type IORef = STRef MainStore
> newIORef v = stToIO (newSTRef v)
> readIORef r = stToIO (readSTRef r)
> writeIORef r v = stToIO (writeSTRef r v)
> eqIORef = eqSTRef

and so on.  This is pretty much what the GHC libraries do, but I think
that exposing it would present a simpler picture, as well as making it
possible to use ST code directly on IORef's.

___
Glasgow-haskell-bugs mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs



Re: type of stToIO

2000-10-06 Thread Ross Paterson

On Fri, Oct 06, 2000 at 02:56:52AM -0700, Simon Marlow wrote:
> GHC's stToIO currently has a different meaning: it embeds the ST
> computation into the I/O monad, using the fact that IO is an instance
> of ST.  Or in other words, IO is just one distinguished state thread,
> which we're calling RealWorld.

I'd put that slightly differently: ST MainStore is a sub-monad of IO,
in the sense that there's an injective monad transformer between them,
namely stToIO.  (So the mutable stuff in IO is an instance of the ST stuff.)
Of course internally they may be the same monad, but that's not what
the user would be told.

___
Glasgow-haskell-bugs mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs



RE: Error compiling ghc-0.8.1 in Red Hat Linux 7.0

2000-10-06 Thread Simon Marlow

Manuel is working on this one at the moment.  Hopefully we'll have a fix
soon.

Cheers,
Simon

> Hello.
> 
> When trying to rebuild the GHC rpms distributed by Manuel
> M. T. Chakravarty, I got some errors:
> 
> -
> [...]
> ../driver/ghc-inplace -I../includes -I. -Iparallel -optc-Wall 
>  -optc-W -optc-Wst
> rict-prototypes  -optc-Wmissing-prototypes  
> -optc-Wmissing-declarations -optc-Wi
> nline -optc-Waggregate-return -optc-Wpointer-arith 
> -optc-Wbad-function-cast -O2 
> -optc-DCOMPILING_RTS -static-c Exception.hc -o Exception.o -osuf o
> Prologue junk?: .globl blockAsyncExceptionszh_fast
> blockAsyncExceptionszh_fast:
> subl$12, %esp
> 
> make[2]: *** [Exception.o] Error 255
> make[1]: *** [all] Error 1
> make: *** [all] Error 1
> -
> 
> Then I have tried the older GCC compiler (kgcc, which is really
> egcs-2.91.66) distributed by Red Hat in order to compile the
> Linux kernel (as the default GCC, 2.96, is not suitable for that),
> with no success:
> 
> -
> [...]
> --
> --
> ==fptools== make all - --no-print-directory -r;
>  in /home/romildo/rpms/BUILD/fptools/ghc/compiler
> --
> --
> /usr/bin/ghc -cpp -fglasgow-exts -Rghc-timing -I. -IcodeGen 
> -InativeGen -Iparser 
> -iutils:basicTypes:types:hsSyn:prelude:rename:typecheck:deSuga
> r:coreSyn:specialise:simplCore:stranal:stgSyn:simplStg:codeGen
> :absCSyn:main:profiling:parser:usageSP:cprAnalysis:javaGen:nat
> iveGen -recomp -O  -fvia-C -monly-3-regs 
> -optC-funfolding-interface-threshold7  -c 
> utils/PrimPacked.lhs -o utils/PrimPacked.o -osuf o
> < residency (4 samples), 12M in use, 0.09 INIT (3.03 elapsed), 
> 3.13 MUT (4.48 elapsed), 1.74 GC (2.18 elapsed) :ghc>>
> Prologue junk?: .globl __init_PrimPacked
> __init_PrimPacked:
> subl$12, %esp
> 
> make[2]: *** [utils/PrimPacked.o] Error 255
> make[1]: *** [all] Error 1
> make: *** [all] Error 1
> -
> 
> Any hints?
> 
> Romildo
> -- 
> Prof. José Romildo Malaquias <[EMAIL PROTECTED]>
> Departamento de Computação
> Universidade Federal de Ouro Preto
> Brasil
> 
> ___
> Glasgow-haskell-bugs mailing list
> [EMAIL PROTECTED]
> http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs
> 

___
Glasgow-haskell-bugs mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs



RE: PPC port of ghc.

2000-10-06 Thread Simon Marlow

> On Wed, Oct 04, 2000 at 02:04:09AM -0700, Simon Marlow wrote:
> > > I noticed that GHC mentions a powerpc AIX port.  I was 
> > > wondering what the
> > > difficulty would be in porting GHC to Linux-PPC.
> > 
> > Probably not too hard.  The PPC code is still there, but 
> hasn't been tested
> > for a while (AFAIK, ghc 4.xx has never compiled on a PPC).  
> You may need to
> > extract some bits from ghc 3.xx's runtime system.
> > 
> > We'll certainly help out where possible, but I don't think 
> any of us here
> > knows the PPC arch very well...
> 
> So, is it best to start out with the .hc files, even though 
> they say they
> are for x86?  I wasn't quite sure why an architecture was 
> specified for the
> .hc files?

Unfortunately the x86 .hc files won't work.  You can either bootstrap it
"unregisterised" first (safest) or try to bootstrap a registerised version
using .hc files built on a Sparc (which we don't have yet, but I plan to
build some ASAP).

To bootstrap unregisterised you need to generate some .hc files on another
arch by building GHC and its libs with the -unreg flag.

Cheers,
Simon

___
Glasgow-haskell-bugs mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs