Re: [GHC] #1115: GHC concurrency runtime breaks every 497 (and a bit) days

2007-01-30 Thread GHC
#1115: GHC concurrency runtime breaks every 497 (and a bit) days
+---
 Reporter:  Neil Davies |  Owner:  Neil Davies 
 Type:  bug | Status:  reopened
 Priority:  normal  |  Milestone:  6.6.1   
Component:  Runtime System  |Version:  6.6 
 Severity:  major   | Resolution:  
 Keywords:  | Difficulty:  Moderate (1 day)
 Testcase:  |   Architecture:  Unknown 
   Os:  Unknown |  
+---
Changes (by simonmar):

  * resolution:  worksforme =
  * status:  closed = reopened

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/1115
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


Re: Stretching the Storage Manager a little too much...

2007-01-30 Thread Simon Marlow

Michael Weber wrote:
[I am reading ghc-bugs via the list archives, Cc'ing me would make me 
see responses faster]


Here's a simple memoization function:

applyMemo :: (Eq a1,Show a1) = (a1 - b) - MVar [(a1,b)] - (a1 - b)
applyMemo f refTable x1 = unsafePerformIO $ do
-- print x1
table - takeMVar refTable
let key = x1
case lookup key table of
  Nothing - do
let result = f x1
putMVar refTable $! (key,result):table
return result
  Just memo - putMVar refTable table  return memo


The code above is a cut-down example.  Initially, I tried to use 
Data.HashTable, then IORef (Data.Map ...), then MVars.  However, what 
remains is that I get funny results: loop, thread blocked 
indefinitely, hangs, depending on the exact implementation of 
applyMemo, whether I use ghci or ghc, and which function I memoize 
(something with a more interesting call pattern than fib).


Would you mind submitting a complete test case that we can use to reproduce the 
problem?  We can probably reconstruct one from your description, but you 
probably already have the code lying around.


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


Re: [GHC] #936: strange ghci behavior and error with recursive modules

2007-01-30 Thread GHC
#936: strange ghci behavior and error with recursive modules
-+--
 Reporter:  Misha Aizatulin [EMAIL PROTECTED]  |  Owner:  igloo  
 Type:  merge| Status:  new
 Priority:  normal   |  Milestone:  6.6.1  
Component:  GHCi |Version:  6.4.2  
 Severity:  normal   | Resolution: 
 Keywords:   | Difficulty:  Unknown
 Testcase:  ghci.prog007 |   Architecture:  Unknown
   Os:  Linux|  
-+--
Changes (by simonmar):

  * testcase:  = ghci.prog007
  * owner:  = igloo
  * type:  bug = merge

Comment:

 Fixed, please merge:

 {{{
 Tue Jan 30 02:13:06 PST 2007  Simon Marlow [EMAIL PROTECTED]
   * Fix for #936
 }}}

 and testsuite:

 {{{
 Tue Jan 30 02:10:59 PST 2007  Simon Marlow [EMAIL PROTECTED]
   * add test for bug #036
 }}}

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/936
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


[GHC] #1125: module main:Foo is not loaded when trying to load a module from a user package in ghci

2007-01-30 Thread GHC
#1125: module main:Foo is not loaded when trying to load a module from a user
package in ghci
-+--
Reporter:  igloo |   Owner: 
Type:  bug   |  Status:  new
Priority:  normal|   Milestone:  6.6.1  
   Component:  Compiler  | Version:  6.6
Severity:  normal|Keywords: 
  Difficulty:  Unknown   |Testcase: 
Architecture:  Unknown   |  Os:  Unknown
-+--
When installing a cabal package as a user, loading a module from the
 package in ghci fails; it looks like it's got the package wrong.

 {{{
 $ ghc --make Setup
 [...]
 $ ./Setup configure --prefix=/tmp/foo
 [...]
 $ ./Setup build
 [...]
 $ ./Setup install --user
 [...]
 $ ghci
 [...]
 Prelude :m + Foo
 module main:Foo is not loaded
 }}}

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/1125
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


[GHC] #1126: Add Data.String, containing IsString(fromString), to base

2007-01-30 Thread GHC
#1126: Add Data.String, containing IsString(fromString), to base
---+
Reporter:  igloo   |   Owner: 
Type:  proposal|  Status:  new
Priority:  normal  |   Milestone:  Not GHC
   Component:  libraries/base  | Version:  6.6
Severity:  normal  |Keywords: 
  Difficulty:  Unknown |Testcase: 
Architecture:  Unknown |  Os:  Unknown
---+
Proposal to create a new module Data.String, containing
 IsString(fromString), to the base package. This would be used by the
 overloaded strings extension (-foverloaded-strings in GHC).

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/1126
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


Re: [GHC] #1126: Add Data.String, containing IsString(fromString), to base

2007-01-30 Thread GHC
#1126: Add Data.String, containing IsString(fromString), to base
+---
 Reporter:  igloo   |  Owner: 
 Type:  proposal| Status:  new
 Priority:  normal  |  Milestone:  Not GHC
Component:  libraries/base  |Version:  6.6
 Severity:  normal  | Resolution: 
 Keywords:  | Difficulty:  Unknown
 Testcase:  |   Architecture:  Unknown
   Os:  Unknown |  
+---
Old description:

 Proposal to create a new module Data.String, containing
 IsString(fromString), to the base package. This would be used by the
 overloaded strings extension (-foverloaded-strings in GHC).

New description:

 Proposal to create a new module Data.String, containing
 IsString(fromString), to the base package. This would be used by the
 overloaded strings extension (-foverloaded-strings in GHC).

 Deadline: 28 Feb 2007

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/1126
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


Re: [GHC] #1080: Arrows desguaring does not take account of bindings in patterns

2007-01-30 Thread GHC
#1080: Arrows desguaring does not take account of bindings in patterns
+---
 Reporter:  simonpj |  Owner:  ross   
 Type:  bug | Status:  new
 Priority:  normal  |  Milestone:  6.6.1  
Component:  Compiler|Version:  6.6
 Severity:  normal  | Resolution: 
 Keywords:  | Difficulty:  Unknown
 Testcase:  arrowcase1  |   Architecture:  Unknown
   Os:  Unknown |  
+---
Changes (by simonpj):

  * owner:  Ross Paterson = ross

Comment:

 See also #1124, which is a dup of this one.  I've added its code as an
 attachment, `Ar.hs`.

 Simon

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/1080
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


Re: [GHC] #1124: Panic! The impossible happened: initC srt

2007-01-30 Thread GHC
#1124: Panic! The impossible happened: initC srt
--+-
 Reporter:  guest |  Owner:   
 Type:  bug   | Status:  closed   
 Priority:  normal|  Milestone:   
Component:  Compiler  |Version:  6.7  
 Severity:  blocker   | Resolution:  duplicate
 Keywords:| Difficulty:  Unknown  
 Testcase:|   Architecture:  x86  
   Os:  Linux |  
--+-
Changes (by simonpj):

  * resolution:  = duplicate
  * status:  new = closed

Comment:

 Harald,

 Thanks for a fine report.  It's a duplicate of #1080, which Ross Paterson
 is working on.  I've added your example to #1080, and closing this as a
 dup.

 Simon

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/1124
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


Re: [GHC] #1123: forall not hoisted properly

2007-01-30 Thread GHC
#1123: forall not hoisted properly
--+-
 Reporter:  Ashley Yakeley [EMAIL PROTECTED]  |  Owner: 
 Type:  bug   | Status:  new
 Priority:  normal|  Milestone: 
Component:  Compiler  |Version:  6.6
 Severity:  normal| Resolution: 
 Keywords:| Difficulty:  Unknown
 Testcase:|   Architecture:  Unknown
   Os:  Unknown   |  
--+-
Comment (by simonpj):

 Good program.   I believe this is another place where the quest for
 impredicativity has led me to make GHC's behaviour worse for ordinary
 predicative programs.  This particular program is, I believe, rejected by
 the rules of our paper Boxy types: inference for 

 It's very helpful having examples like these to guide thinking.  I wonder
 if anyone actually uses impredicativity.  It carries heavier costs than
 I'd anticipated.

 Simon

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/1123
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


Re: [GHC] #1122: Trying to declare an infix newtype yields ghc panic

2007-01-30 Thread GHC
#1122: Trying to declare an infix newtype yields ghc panic
--+-
 Reporter:  guest |  Owner: 
 Type:  merge | Status:  new
 Priority:  normal|  Milestone: 
Component:  Compiler  |Version:  6.6
 Severity:  normal| Resolution: 
 Keywords:| Difficulty:  Unknown
 Testcase:  tc173 |   Architecture:  x86
   Os:  Linux |  
--+-
Changes (by simonpj):

  * testcase:  = tc173
  * type:  bug = merge

Comment:

 You need to use an infix type *constructor*, which must start with a
 colon.

 The crash is bad -- thanks for the report.  Now fixed. Test case is
 tcfail731.

 Please merge to 6.6.1.

 Simon

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/1122
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


[GHC] #1127: Make StateT in mtl truly lazy

2007-01-30 Thread GHC
#1127: Make StateT in mtl truly lazy
--+-
Reporter:  igloo  |   Owner: 
Type:  proposal   |  Status:  new
Priority:  normal |   Milestone:  Not GHC
   Component:  libraries (other)  | Version:  6.6
Severity:  normal |Keywords: 
  Difficulty:  Unknown|Testcase: 
Architecture:  Unknown|  Os:  Unknown
--+-
The StateT monad gives every impression of intending to be lazy, but the
 absence of a ~ means that it isn't fully lazy. This bit me in the
 compression library, meaning I currently bundle a LazyStateT module that
 provides essentially StateT with this change. There was also a recent
 discussion about it on one of the mailing lists:
 http://www.haskell.org/pipermail/haskell-cafe/2007-January/021244.html

 I propose making StateT lazy.

 Deadline: 28 February 2007.

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/1127
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


Re: [GHC] #1121: Error message Expecting a function type, but found `w_a1Kh'

2007-01-30 Thread GHC
#1121: Error message Expecting a function type, but found `w_a1Kh'
-+--
 Reporter:  [EMAIL PROTECTED]   |  Owner: 
 Type:  bug  | Status:  closed 
 Priority:  normal   |  Milestone: 
Component:  Compiler (Type checker)  |Version:  6.4.2  
 Severity:  normal   | Resolution:  wontfix
 Keywords:   | Difficulty:  Unknown
 Testcase:   |   Architecture:  x86
   Os:  Linux|  
-+--
Changes (by simonpj):

  * resolution:  = wontfix
  * status:  new = closed

Old description:

 When compiling with GHC or loading into GHCi the following module I get a
 strange error:

 module Bla where

 bla :: String - String
 bla x = unwords $ [ ('#':) ]

 The error is:

 Bug.hs:4:20:
 Expecting a function type, but found `w_a1bp'
   Expected type: String
   Inferred type: [Char] - [Char]
 In the expression: ('#' :)
 In the list element: ('#' :)

 Writing the function as:

 bla = words [ ('#':) ]

 produces the correct error message with [Char] instead of `w_a1bp'.

 I was doing this with GHC-6.4.2 on Ubuntu with a 2.6.17 kernel.

New description:

 When compiling with GHC or loading into GHCi the following module I get a
 strange error:
 {{{
 module Bla where

 bla :: String - String
 bla x = unwords $ [ ('#':) ]
 }}}
 The error is:
 {{{
 Bug.hs:4:20:
 Expecting a function type, but found `w_a1bp'
   Expected type: String
   Inferred type: [Char] - [Char]
 In the expression: ('#' :)
 In the list element: ('#' :)
 }}}
 Writing the function as:
 {{{
 bla = words [ ('#':) ]
 }}}
 produces the correct error message with [Char] instead of `w_a1bp'.

 I was doing this with GHC-6.4.2 on Ubuntu with a 2.6.17 kernel.

Comment:

 Happily, this is fine in GHC 6.6.  I don't think it's serious enough to
 fix in 6.4.  Thanks for reporting it though.  We always like to hear about
 poor error messages.

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/1121
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


Re: [GHC] #942: Windows programs throw uncaught Invalid HANDLE exception on exit

2007-01-30 Thread GHC
#942: Windows programs throw uncaught Invalid HANDLE exception on exit
+---
 Reporter:  [EMAIL PROTECTED] |  Owner:  igloo  
 Type:  bug | Status:  closed 
 Priority:  normal  |  Milestone:  6.6.1  
Component:  Runtime System  |Version:  6.6
 Severity:  major   | Resolution:  fixed  
 Keywords:  uncaught exception HANDLE exit  | Difficulty:  Unknown
 Testcase:  N/A |   Architecture:  x86
   Os:  Windows |  
+---
Changes (by igloo):

  * resolution:  = fixed
  * status:  new = closed

Comment:

 I've now confirmed that it also works in the 6.6 branch.

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/942
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


Re: [GHC] #936: strange ghci behavior and error with recursive modules

2007-01-30 Thread GHC
#936: strange ghci behavior and error with recursive modules
-+--
 Reporter:  Misha Aizatulin [EMAIL PROTECTED]  |  Owner:  igloo  
 Type:  merge| Status:  closed 
 Priority:  normal   |  Milestone:  6.6.1  
Component:  GHCi |Version:  6.4.2  
 Severity:  normal   | Resolution:  fixed  
 Keywords:   | Difficulty:  Unknown
 Testcase:  ghci.prog007 |   Architecture:  Unknown
   Os:  Linux|  
-+--
Changes (by igloo):

  * resolution:  = fixed
  * status:  new = closed

Comment:

 Merged.

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/936
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


Re: [GHC] #1059: Control.Monad.Error documentation

2007-01-30 Thread GHC
#1059: Control.Monad.Error documentation
---+
 Reporter:  Andriy |  Owner:  igloo   
 Type:  proposal   | Status:  closed  
 Priority:  normal |  Milestone:  6.6.1   
Component:  libraries (other)  |Version:  6.6 
 Severity:  minor  | Resolution:  fixed   
 Keywords: | Difficulty:  Moderate (1 day)
 Testcase: |   Architecture:  Multiple
   Os:  Multiple   |  
---+
Changes (by igloo):

  * resolution:  = fixed
  * status:  new = closed

Comment:

 I've applied the doc changes.

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/1059
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


Re: [GHC] #1122: Trying to declare an infix newtype yields ghc panic

2007-01-30 Thread GHC
#1122: Trying to declare an infix newtype yields ghc panic
--+-
 Reporter:  guest |  Owner:  igloo  
 Type:  merge | Status:  new
 Priority:  normal|  Milestone:  6.6.1  
Component:  Compiler  |Version:  6.6
 Severity:  normal| Resolution: 
 Keywords:| Difficulty:  Unknown
 Testcase:  tc173 |   Architecture:  x86
   Os:  Linux |  
--+-
Changes (by igloo):

  * milestone:  = 6.6.1
  * owner:  = igloo

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/1122
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


Re: [GHC] #1123: forall not hoisted properly

2007-01-30 Thread GHC
#1123: forall not hoisted properly
--+-
 Reporter:  Ashley Yakeley [EMAIL PROTECTED]  |  Owner: 
 Type:  bug   | Status:  new
 Priority:  normal|  Milestone:  6.8
Component:  Compiler  |Version:  6.6
 Severity:  normal| Resolution: 
 Keywords:| Difficulty:  Unknown
 Testcase:|   Architecture:  Unknown
   Os:  Unknown   |  
--+-
Changes (by igloo):

  * milestone:  = 6.8

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/1123
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


Re: [GHC] #418: unsafeInterleaveIO + Ctrl-C/killThread related segfault

2007-01-30 Thread GHC
#418: unsafeInterleaveIO + Ctrl-C/killThread related segfault
+---
 Reporter:  remit   |  Owner:  igloo  
 Type:  bug | Status:  new
 Priority:  lowest  |  Milestone:  6.6.1  
Component:  Runtime System  |Version:  6.4.1  
 Severity:  normal  | Resolution:  None   
 Keywords:  | Difficulty:  Unknown
 Testcase:  |   Architecture:  Unknown
   Os:  Unknown |  
+---
Changes (by igloo):

  * milestone:  = 6.6.1

Comment:

 Actually, I'm not so sure this is working properly after all, now.

 I'd expect this to manage to print () at some point even with the non-
 threaded RTS, but it doesn't:

 {{{
 module Main where

 import Control.Concurrent
 import System.IO.Unsafe (unsafeInterleaveIO)

 main = do
 v - newEmptyMVar
 a - unsafeInterleaveIO (readMVar v)
 t - forkIO (print a)
 threadDelay (1000*1000)
 killThread t
 forkIO $ do putStrLn W1
 print a
 putStrLn W2
 putStrLn Q1
 putMVar v ()
 putStrLn Q2
 putMVar v ()
 putStrLn Q3
 threadDelay (1000*1000)
 putStrLn Q4
 isEmptyMVar v = print
 putStrLn Q5
 putMVar v ()
 putStrLn Q6
 }}}

 I get:

 {{{
 Q1W1
 Q2

 Q3
 Q4
 False
 Q5
 conc067: thread blocked indefinitely
 }}}

 (the thread blocked indefinitely I do expect).

 With the threaded RTS I get

 {{{
 Q1W1

 ()
 W2
 Q2
 conc067: thread blocked indefinitely
 }}}

 which also seems wrong as I expect to be able to get all the way to Q5.

 SimonM, what do you think?

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/418
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


[GHC] #1128: The impossible happened, code commented

2007-01-30 Thread GHC
#1128: The impossible happened, code commented
-+--
Reporter:  humasect  |   Owner: 
Type:  bug   |  Status:  new
Priority:  normal|   Milestone:  6.6.1  
   Component:  Compiler  | Version:  6.6
Severity:  major |Keywords: 
  Difficulty:  Unknown   |Testcase: 
Architecture:  Unknown   |  Os:  Unknown
-+--
initializeWorld = (\w - do
 worldSetGravity w 0 (-1.0) 0
 worldSetERP w 0.2
 worldSetCFM w 1e-5
 worldSetContactMaxCorrectingVel w 0.9
 worldSetContactSurfaceLayer w 0.001
 worldSetAutoDisableFlag w 1),

 these worldSet* functions are unsafe FFI calls. initializeWorld is Ptr Int
 - IO ()

 commenting this prevents this bug. this code is found in a top level
 declaration:

 initiailLevel = Level {
  ...
 }

 of which contains the record for initializeWorld

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/1128
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs