Re: validate --slow bugs (was Re: Status updates)

2014-09-06 Thread Thomas Miedema
>
> >  - I still think we should turn on --slow mode for our buildbots soon,
> > but this will cause noise. I'd really like some inputs on this - maybe
> > someone would like to help clean up the 'slow' vaildate failures?
> > Bonus points for this, since you don't even have to
>
> That's a great goal, but --slow enables compiler debug assertions,
> which seem to trigger real errors (full log of failures attached).


Also note that when debugging is on, tests that call
`compiler_stats_num_field` are currently skipped
.
This applies to almost all tests in `tests/perf/compiler`.
___
ghc-devs mailing list
ghc-devs@haskell.org
http://www.haskell.org/mailman/listinfo/ghc-devs


Trac

2014-09-06 Thread Simon Peyton Jones
Trac is still very slow, and super-hard to update a wiki page without getting 
"database locked" and often losing all your eits.
It would be great if this could be fixed somehow.
Simon
___
ghc-devs mailing list
ghc-devs@haskell.org
http://www.haskell.org/mailman/listinfo/ghc-devs


RE: Problems with building GHC 7.8.3 on Windows

2014-09-06 Thread Simon Peyton Jones
Marek

This sounds great.  Can you update the wiki page so that it says exactly what 
to do?

I’m copying Neil Mitchell who is interested in doing the same

Thank you!

Simon


From: ghc-devs [mailto:ghc-devs-boun...@haskell.org] On Behalf Of Marek Wawrzos
Sent: 02 September 2014 10:26
Cc: ghc-devs@haskell.org
Subject: Re: Problems with building GHC 7.8.3 on Windows

I have finally builded GHC 7.8.3 on Windows. The wiki page with MSYS2 that you 
linked to proved to be useful reference. Indeed using the latest 64 bit MSYS2 
as building environment solved my problems. However there are some issues with 
the instructions presented:
-- the MSYS2 package that is linked to in the page fails to initial update. 
Using the latest official MSYS2 package does solve that ( 
https://sourceforge.net/projects/msys2/files/Base/x86_64 );
-- initial update has to be done along the instructions from 
http://sourceforge.net/p/msys2/wiki/MSYS2%20installation/ ;
There are some error outputs during initial update but they do not seem to 
cause any harm
I thing it might be a good idea to give stronger encouragement to use MSYS2 on 
the page with Windows-specific instructions. It suggests that old MSYS can be 
used successfully while it apparently fails and is not supported.

2014-08-29 17:59 GMT+02:00 kyra mailto:ky...@mail.ru>>:
1. I see you've set ticket's 'Architecture' field to be 'x86_64' while make 
output suggests you try to build 32-bit ghc.

2. You are using 'old' MSys which is known to be problematic when building GHC. 
It's much better to use MSYS2 now: 
https://ghc.haskell.org/trac/ghc/wiki/Building/Preparation/Windows/MSYS2.

Also, remember, MSYS2 is only a *build environment*, so you can use 64-bit 
MSYS2 to build 32-bit GHC on 64-bit Windows. My experience is that 64-bit MSYS2 
is more solid and stable than 32-bit MSYS2. And it's extremely important to 
remember you must *not* use msys2_shell.bat to start MSYS2 shell, only 
mingwXX_shell.bat (XX stands for 32 or 64) shall be used to start MSYS2 shell 
-- otherwise GHC make system would not recognize build triplet.

Cheers,
Kyra



On 8/29/2014 17:50, Marek Wawrzos wrote:
Hello,

I am trying to compile GHC 7.8.3 on Windows. I was following the instructions 
from the GHC wiki, but I have encountered errors during the make process.

I have filed a bug report describing my issue: 
https://ghc.haskell.org/trac/ghc/ticket/9513

Does anyone had working setup for building GHC and would be willing to share 
information on how to achieve it?

--
Best regards,
Marek Wawrzos

___
ghc-devs mailing list
ghc-devs@haskell.org
http://www.haskell.org/mailman/listinfo/ghc-devs

___
ghc-devs mailing list
ghc-devs@haskell.org
http://www.haskell.org/mailman/listinfo/ghc-devs



--
Z poważaniem,
Marek Wawrzos
___
ghc-devs mailing list
ghc-devs@haskell.org
http://www.haskell.org/mailman/listinfo/ghc-devs


Trying to fix an efficiency issue noted in a TODO in SAT.hs

2014-09-06 Thread David Feuer
compiler/simplCore/SAT.hs has a TODO comment about the fact that it does a
fair bit of appending onto the ends of lists, and that should be done
differently. I made an attempt to fix it. The complexity of the recursion,
however, leaves me uncertain as to whether I really did or not. I've
attached a diff and I hope someone will be able to take a look at it. The
only use of Sequence.fromList is source line 172, and the only significant
use of Foldable.toList (aside from pretty-printing) is on source line 402.
Note that the use of Sequence may be temporary—I want to get the right code
structure down before choosing the best data structure.

Thanks,
David Feuer
diff --git a/compiler/simplCore/SAT.lhs b/compiler/simplCore/SAT.lhs
index a0b3151..aae3e69 100644
--- a/compiler/simplCore/SAT.lhs
+++ b/compiler/simplCore/SAT.lhs
@@ -67,10 +67,16 @@ import VarSet
 import Unique
 import UniqSet
 import Outputable
-
 import Data.List
 import FastString
 
+--We're probably not really going to use Data.Sequence
+--this is just a temporary temporary thing to see what we'll
+--actually need.
+import qualified Data.Sequence as S
+import Data.Foldable (toList)
+import Data.Sequence (Seq, (|>), (<|), (><), fromList)
+
 #include "HsVersions.h"
 \end{code}
 
@@ -118,7 +124,7 @@ data Staticness a = Static a | NotStatic
 
 type IdAppInfo = (Id, SATInfo)
 
-type SATInfo = [Staticness App]
+type SATInfo = Seq (Staticness App) -- [Staticness App]
 type IdSATInfo = IdEnv SATInfo
 emptyIdSATInfo :: IdSATInfo
 emptyIdSATInfo = emptyUFM
@@ -129,7 +135,7 @@ pprIdSATInfo id_sat_info = vcat (map pprIdAndSATInfo 
(Map.toList id_sat_info))
 -}
 
 pprSATInfo :: SATInfo -> SDoc
-pprSATInfo staticness = hcat $ map pprStaticness staticness
+pprSATInfo staticness = hcat $ map pprStaticness $ toList staticness
 
 pprStaticness :: Staticness App -> SDoc
 pprStaticness (Static (VarApp _))  = ptext (sLit "SV")
@@ -139,15 +145,22 @@ pprStaticness NotStatic= ptext (sLit "NS")
 
 
 mergeSATInfo :: SATInfo -> SATInfo -> SATInfo
-mergeSATInfo [] _  = []
-mergeSATInfo _  [] = []
-mergeSATInfo (NotStatic:statics) (_:apps) = NotStatic : mergeSATInfo statics 
apps
-mergeSATInfo (_:statics) (NotStatic:apps) = NotStatic : mergeSATInfo statics 
apps
-mergeSATInfo ((Static (VarApp v)):statics)  ((Static (VarApp v')):apps)  = (if 
v == v' then Static (VarApp v) else NotStatic) : mergeSATInfo statics apps
-mergeSATInfo ((Static (TypeApp t)):statics) ((Static (TypeApp t')):apps) = (if 
t `eqType` t' then Static (TypeApp t) else NotStatic) : mergeSATInfo statics 
apps
-mergeSATInfo ((Static (CoApp c)):statics) ((Static (CoApp c')):apps) = (if 
c `coreEqCoercion` c' then Static (CoApp c) else NotStatic) : mergeSATInfo 
statics apps
-mergeSATInfo l  r  = pprPanic "mergeSATInfo" $ ptext (sLit "Left:") <> 
pprSATInfo l <> ptext (sLit ", ")
-<> ptext (sLit "Right:") <> 
pprSATInfo r
+mergeSATInfo l r = S.zipWith mergeSA l r
+  where
+mergeSA NotStatic _ = NotStatic
+mergeSA _ NotStatic = NotStatic
+mergeSA (Static (VarApp v)) (Static (VarApp v'))
+  | v == v'   = Static (VarApp v)
+  | otherwise = NotStatic
+mergeSA (Static (TypeApp t)) (Static (TypeApp t'))
+  | t `eqType` t' = Static (TypeApp t)
+  | otherwise = NotStatic
+mergeSA (Static (CoApp c)) (Static (CoApp c'))
+  | c `coreEqCoercion` c' = Static (CoApp c)
+  | otherwise = NotStatic
+mergeSA _ _  = pprPanic "mergeSATInfo" $ ptext (sLit "Left:")
+   <> pprSATInfo l <> ptext (sLit ", ")
+   <> ptext (sLit "Right:") <> pprSATInfo r
 
 mergeIdSATInfo :: IdSATInfo -> IdSATInfo -> IdSATInfo
 mergeIdSATInfo = plusUFM_C mergeSATInfo
@@ -156,7 +169,7 @@ mergeIdSATInfos :: [IdSATInfo] -> IdSATInfo
 mergeIdSATInfos = foldl' mergeIdSATInfo emptyIdSATInfo
 
 bindersToSATInfo :: [Id] -> SATInfo
-bindersToSATInfo vs = map (Static . binderToApp) vs
+bindersToSATInfo vs = fromList $ map (Static . binderToApp) vs
 where binderToApp v | isId v= VarApp v
 | isTyVar v = TypeApp $ mkTyVarTy v
 | otherwise = CoApp $ mkCoVarCo v
@@ -178,7 +191,7 @@ satTopLevelExpr expr interesting_ids = do
 satExpr :: CoreExpr -> IdSet -> SatM (CoreExpr, IdSATInfo, Maybe IdAppInfo)
 satExpr var@(Var v) interesting_ids = do
 let app_info = if v `elementOfUniqSet` interesting_ids
-   then Just (v, [])
+   then Just (v, S.empty)
else Nothing
 return (var, emptyIdSATInfo, app_info)
 
@@ -195,8 +208,7 @@ satExpr (App fn arg) interesting_ids = do
 case fn_app of
 Nothing -> satRemainder Nothing
 Just (fn_id, fn_app_info) ->
--- TODO: remove this use of append somehow (use a data structure 
with O(1) append but a left-to-right kind of interface)
-let satRemainderWithStaticness arg_staticness = satRemainder $ 
Just (fn_id, fn_app_info ++ [arg