Re: [GHC] #1838: do not use getEnv HOME, use System.Directory.getHomeDirectory

2008-01-22 Thread GHC
#1838: do not use getEnv HOME, use System.Directory.getHomeDirectory
-+--
 Reporter:  guest|  Owner:  simonmar
 Type:  bug  | Status:  new 
 Priority:  high |  Milestone:  6.8.3   
Component:  GHCi |Version:  6.8.2   
 Severity:  normal   | Resolution:  
 Keywords:   | Difficulty:  Unknown 
 Testcase:   |   Architecture:  Unknown 
   Os:  Windows  |  
-+--
Changes (by simonmar):

  * owner:  = simonmar

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/1838#comment:6
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] #1767: :show setting does not conform to documented specification

2008-01-22 Thread GHC
#1767: :show setting does not conform to documented specification
-+--
 Reporter:  guest|  Owner:  simonmar
 Type:  bug  | Status:  new 
 Priority:  normal   |  Milestone:  6.8.3   
Component:  GHCi |Version:  6.9 
 Severity:  normal   | Resolution:  
 Keywords:   | Difficulty:  Unknown 
 Testcase:   |   Architecture:  Unknown 
   Os:  Unknown  |  
-+--
Changes (by simonmar):

  * owner:  = simonmar

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/1767#comment:4
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: Integrating editline with ghc

2008-01-22 Thread Christian Maeder
Malcolm Wallace wrote:
 I think I am persuaded that this is the most important goal: stability
 of the API and package interface, for existing clients of readline.  If
 individual projects would like to migrate from using readline to using
 editline, then those are the ones that should pay the small amount of
 pain (in using CPP, package configurations, etc) to manage the change.
 
 Anyone else should be totally unaffected.

I would like to know from package maintainers if there packages can be
easily ported from libreadline to libedit.

The best indication for this would be if the package is also happy with
a restricted interface of readline (i.e. readline-compat) or requires
the full GNU readline.

At least testing this compatibility makes sense using a readline package
with a temporarily reduced interface (without the need to change the
packages depending on readline.)

Christian

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


Re: [GHC] #1136: High memory use when compiling many let bindings.

2008-01-22 Thread GHC
#1136: High memory use when compiling many let bindings.
--+-
 Reporter:  igloo |  Owner: 
 Type:  compile-time performance bug  | Status:  new
 Priority:  high  |  Milestone:  6.8.3  
Component:  Compiler  |Version:  6.6
 Severity:  normal| Resolution: 
 Keywords:  performance   | Difficulty:  Unknown
 Testcase:|   Architecture:  Unknown
   Os:  Unknown   |  
--+-
Comment (by igloo):

 J_mem_vs_time.png shows the memory use against time for J.hs, with
 different values of numa/numb. It doesn't look like there is a complexity
 problem, but the constant factor seems high, using about 10k per binding.
 J_heap_profile.png is the heap profile for the largest case (400/2),
 and peak usage works out at about 5k per binding (the difference
 presumably being due to the copying GC). Typecheck-Rename stands out, but
 there are also a few other large space users.

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/1136#comment:7
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] #2049: GHCi doesn't fully load previously broken modules

2008-01-22 Thread GHC
#2049: GHCi doesn't fully load previously broken modules
-+--
 Reporter:  ajd  |  Owner:  igloo  
 Type:  merge| Status:  new
 Priority:  normal   |  Milestone:  6.8.3  
Component:  GHCi |Version:  6.8.2  
 Severity:  normal   | Resolution: 
 Keywords:   | Difficulty:  Unknown
 Testcase:   |   Architecture:  Unknown
   Os:  Unknown  |  
-+--
Changes (by simonmar):

  * owner:  simonmar = igloo
  * type:  bug = merge

Comment:

 Fixed, to merge:

 {{{
 Mon Jan 21 06:59:35 PST 2008  Simon Marlow [EMAIL PROTECTED]
   * FIX #2049, another problem with the module context on :reload
 }}}

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/2049#comment:3
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] #1839: need ghc-pkg dump feature

2008-01-22 Thread GHC
#1839: need ghc-pkg dump feature
--+-
 Reporter:  duncan|  Owner:  igloo  
 Type:  merge | Status:  new
 Priority:  normal|  Milestone:  6.8.3  
Component:  Compiler  |Version:  6.8.1  
 Severity:  normal| Resolution: 
 Keywords:| Difficulty:  Unknown
 Testcase:|   Architecture:  Unknown
   Os:  Unknown   |  
--+-
Changes (by simonmar):

  * owner:  = igloo
  * type:  feature request = merge

Comment:

 To merge:

 {{{
 Mon Jan 21 08:17:44 PST 2008  [EMAIL PROTECTED]
   * FIX #1839, #1463, by supporting ghc-pkg bulk queries with substring
 matching
 Tue Jan 22 08:18:11 PST 2008  Simon Marlow [EMAIL PROTECTED]
   * This goes with the patch for #1839, #1463
 }}}

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/1839#comment:11
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] #2060: Unknown opcode 10904

2008-01-22 Thread GHC
#2060: Unknown opcode 10904
--+-
Reporter:  ezrakilty  |   Owner:  
Type:  bug|  Status:  new 
Priority:  normal |   Component:  Compiler
 Version:  6.6|Severity:  normal  
Keywords: |Testcase:  
Architecture:  x86|  Os:  MacOS X 
--+-
 I got this error working with ghci just now. Contrary to what it says, I'm
 not on linux but on Mac OS X 10.4.11 (intel).

 {{{
 *Main quickCheck prop_typecheck
 interactive: internal error: interpretBCO: unknown or unimplemented
 opcode 10904
 (GHC version 6.6 for i386_unknown_linux)
 Please report this as a GHC bug:
 http://www.haskell.org/ghc/reportabug
 }}}

 The text of the program follows.

 {{{
 import Foreign (unsafePerformIO)
 import List (nub)
 import System.Random (mkStdGen)
 import Test.QuickCheck

 data Term = Const | Var Int | Abs Term | Appl Term Term
 deriving (Show)
 data Type = Base | Type :-: Type
 deriving (Eq, Show)

 data TypeScheme = T Type | V Int | Arr TypeScheme TypeScheme
   deriving (Eq, Show)

 eval env Const = Const
 eval env (Var x) | x  length env = env !! x
 eval env (Abs n) = Abs n
 eval env (Appl m n) = case eval env m of
 Abs m' - eval env' m'
 where env' = eval env n : env
 _ - error non-functional application

 data Fresh a = Fr(Int - (Int, a))

 instance Monad Fresh where
  return x = Fr(\ctr - (ctr, x))
  (Fr m) = f = Fr(\x - let (ctr, x') = m x in
  let Fr f' = f x' in
  f' ctr)

 fresh :: Fresh Int
 fresh = Fr(\ctr - (ctr+1, ctr))

 runFresh (Fr f) = snd $ f 0

 arrowTy (s :-: t) = True
 arrowTy _ = False

 unify (T s) (T t) | s == t = Just[]
 unify (V x) t = Just [(x, t)]
 unify s (V y) = Just [(y, s)]
 unify (Arr s1 t1) (Arr s2 t2) =
 do subst1 - unify s1 s2
subst2 - unify t1 t2
Just (List.nub $ subst1 ++ subst2)

 applySubst :: (Int, TypeScheme) - TypeScheme - TypeScheme
 applySubst (x, xIm) (T ty) = T ty
 applySubst (x, xIm) (V y) | x == y = xIm
   | otherwise = V y
 applySubst (x, xIm) (Arr s t) = Arr (applySubst (x, xIm) s)
 (applySubst (x, xIm) t)

 applySubsts :: [(Int, TypeScheme)] - TypeScheme - TypeScheme
 applySubsts substs ty = foldr (applySubst) ty substs

 typeCheck :: [TypeScheme] - Term - Fresh TypeScheme
 typeCheck env Const = return $ T Base
 typeCheck env (Var x) | x  length env = return (env !! x)
 typeCheck env (Abs n) =
 do xTy - fresh
nTy - typeCheck (V xTy : env) n
return (Arr (V xTy) nTy)
 typeCheck env (Appl m n) =
 do mTy - typeCheck env m
nTy - typeCheck env n
case mTy of
 Arr mArgTy mResTy -
 case unify mArgTy nTy of
   Nothing - error unification failed
   Just substn -
   return (applySubsts substn mResTy)
 _ -  error ill-typed application

 typeGen :: Int - Gen Type
 typeGen size = oneof $
 [return Base] ++
 if size = 0 then [] else
 [do s - typeGen (size-1)
 t - typeGen (size-1)
 return $ s :-: t ]

 asList Nothing = []
 asList (Just x) = [x]

 oneofMaybe :: [Gen(Maybe a)] - Gen (Maybe a)
 oneofMaybe [] = return Nothing
 oneofMaybe (x:xs) = do x' - x
xs' - oneofMaybe xs
case (x', xs') of
  (Nothing, Nothing) - return Nothing
  _ - oneof (map (return . Just) $
  asList x' ++ asList xs')

 typedTermGen :: [Type] - Type - Int - Gen (Maybe Term)
 typedTermGen ctxt tau size = oneofMaybe (
 (case tau of
   Base - [return $ Just Const]
   tau :-: tau' -
   if size = 0 then [] else
   [do n - typedTermGen (tau:ctxt) tau' decSize
   return $ do n' - n
   Just(Abs n')]
 ) ++
 (if size = 0 then [] else
 [do sigma - typeGen decSize
 --let sigma = (unsafePerformIO $ putStr $ show sigma') `seq`
 sigma'
 m - typedTermGen ctxt (sigma :-: tau) decSize
 n - typedTermGen ctxt (sigma) decSize
 return $ do m' - m ; n' - n; Just (Appl m' n')
 ]) ++
 [return$ Just (Var x) | (x, xType) - zip [0..] ctxt, xType == tau]
 )
 where decSize = size-1

 -- graph a function over certain inputs
 graph f xs = [(x, f x) | x - xs]

 make n g size = [generate size (System.Random.mkStdGen i) g | i-[0..n]]

 prop_typecheck = forAll (sized (typedTermGen [] Base)) (\m -
 let m' = Maybe.fromJust m in
 (runFresh (typeCheck [] m')) == Some (T Base))
 }}}

-- 
Ticket 

[GHC] #2061: ghc-pkg loops on mutually recursive package dependencies

2008-01-22 Thread GHC
#2061: ghc-pkg loops on mutually recursive package dependencies
---+
Reporter:  trevor  |   Owner:
Type:  bug |  Status:  new   
Priority:  normal  |   Component:  None  
 Version:  6.8.2   |Severity:  normal
Keywords:  |Testcase:
Architecture:  x86_64 (amd64)  |  Os:  Linux 
---+
 If you have two packages installed, A and B, with a dependency from B to
 A, it is possible to create a cyclic dependency by then adding a
 dependency in A to B and reinstalling it.  The result is that ghc-pkg will
 loop, not detecting the cycle.

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/2061
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] #2060: Unknown opcode 10904

2008-01-22 Thread GHC
#2060: Unknown opcode 10904
--+-
Reporter:  ezrakilty  |Owner:   
Type:  bug|   Status:  new  
Priority:  normal |Milestone:   
   Component:  Compiler   |  Version:  6.6  
Severity:  normal |   Resolution:   
Keywords: | Testcase:   
Architecture:  x86|   Os:  Linux
--+-
Changes (by ezrakilty):

  * os:  MacOS X = Linux

Comment:

 Apologies: this error did in fact occur on a Linux setup, not MacOS X as I
 originally said.

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/2060#comment:1
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] #1312: runghc doesn't respect -main-is

2008-01-22 Thread GHC
#1312: runghc doesn't respect -main-is
--+-
 Reporter:  simonmar  |  Owner:  igloo  
 Type:  bug   | Status:  closed 
 Priority:  normal|  Milestone:  6.8.3  
Component:  Compiler  |Version:  6.6.1  
 Severity:  minor | Resolution:  fixed  
 Keywords:| Difficulty:  Easy (1 hr)
 Testcase:|   Architecture:  Multiple   
   Os:  Unknown   |  
--+-
Changes (by igloo):

  * status:  new = closed
  * resolution:  = fixed

Comment:

 OK, this is now done in 6.8 and HEAD, but you need to escape the argument
 to `-main-is` so runghc doesn't think it's the module to load:
 {{{
 runghs -main-is --ghc-arg=foo bar.hs
 }}}
 Perhaps we should have
 {{{
 +GHC ... -GHC
 }}}
 or something, but that's a matter for another ticket!

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/1312#comment:7
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