April 2013 - ghc-devs

[PATCH 2/2] add arm-unknown-linux to platforms which do not support shared libs
by Karel Gardas 04 Apr '13

04 Apr '13

This patch disables shared libs support on arm-unknown-linux platform. It unbreaks ghc-stage2 on this platform after recent Ian's changes in dynamic/shared libs domain. The reason why ghc-stage2 fails when linked with shared libs is still unknown so this is just a workaround at the moment, but it at least recovers previous "correct" behavior of ghc-stage2 on ARM/Linux --- mk/config.mk.in | 2 +- 1 files changed, 1 insertions(+), 1 deletions(-) diff --git a/mk/config.mk.in b/mk/config.mk.in index de55f0d..2a03ecf 100644 --- a/mk/config.mk.in +++ b/mk/config.mk.in @@ -95,7 +95,7 @@ TargetElf = YES endif # Some platforms don't support shared libraries -NoSharedLibsPlatformList = +NoSharedLibsPlatformList = arm-unknown-linux ifeq "$(SOLARIS_BROKEN_SHLD)" "YES" NoSharedLibsPlatformList += i386-unknown-solaris2 -- 1.7.3.2

1 0

[PATCH 1/2] set DYNAMIC_GHC_PROGRAMS to NO if platform does not support shared libs
by Karel Gardas 04 Apr '13

04 Apr '13

--- mk/config.mk.in | 4 ++++ 1 files changed, 4 insertions(+), 0 deletions(-) diff --git a/mk/config.mk.in b/mk/config.mk.in index 275c21a..de55f0d 100644 --- a/mk/config.mk.in +++ b/mk/config.mk.in @@ -135,8 +135,12 @@ ifeq "$(TargetOS_CPP)" "mingw32" # This doesn't work on Windows yet DYNAMIC_GHC_PROGRAMS = NO else +ifeq "$(PlatformSupportsSharedLibs)" "NO" +DYNAMIC_GHC_PROGRAMS = NO +else DYNAMIC_GHC_PROGRAMS = YES endif +endif # Build a compiler that will build *unregisterised* libraries and # binaries by default. Unregisterised code is supposed to compile and -- 1.7.3.2

1 0

Linker error in stage2
by Gabor Greif 04 Apr '13

04 Apr '13

Hi Ian, I am getting linker errors when bootstrapping HEAD with a recent v7.7-20130220 GHC. This is a RHEL5 system: "inplace/bin/ghc-stage1" -package-name rts -shared -dynamic -dynload deploy -no-auto-link-packages -Lrts/dist/build -lffi -optl-Wl,-rpath -optl-Wl,'$ORIGIN' `cat rts/libs.depend` rts/dist/build/Adjustor.debug_dyn_o rts/dist/build/Arena.debug_dyn_o rts/dist/build/Capability.debug_dyn_o rts/dist/build/ClosureFlags.debug_dyn_o rts/dist/build/Disassembler.debug_dyn_o rts/dist/build/FileLock.debug_dyn_o rts/dist/build/FrontPanel.debug_dyn_o rts/dist/build/Globals.debug_dyn_o rts/dist/build/Hash.debug_dyn_o rts/dist/build/Hpc.debug_dyn_o rts/dist/build/HsFFI.debug_dyn_o rts/dist/build/Inlines.debug_dyn_o rts/dist/build/Interpreter.debug_dyn_o rts/dist/build/LdvProfile.debug_dyn_o rts/dist/build/Linker.debug_dyn_o rts/dist/build/Messages.debug_dyn_o rts/dist/build/OldARMAtomic.debug_dyn_o rts/dist/build/Papi.debug_dyn_o rts/dist/build/Printer.debug_dyn_o rts/dist/build/ProfHeap.debug_dyn_o rts/dist/build/Profiling.debug_dyn_o rts/dist/build/Proftimer.debug_dyn_o rts/dist/build/RaiseAsync.debug_dyn_o rts/dist/build/RetainerProfile.debug_dyn_o rts/dist/build/RetainerSet.debug_dyn_o rts/dist/build/RtsAPI.debug_dyn_o rts/dist/build/RtsDllMain.debug_dyn_o rts/dist/build/RtsFlags.debug_dyn_o rts/dist/build/RtsMain.debug_dyn_o rts/dist/build/RtsMessages.debug_dyn_o rts/dist/build/RtsStartup.debug_dyn_o rts/dist/build/RtsUtils.debug_dyn_o rts/dist/build/Schedule.debug_dyn_o rts/dist/build/Sparks.debug_dyn_o rts/dist/build/Stable.debug_dyn_o rts/dist/build/Stats.debug_dyn_o rts/dist/build/StgCRun.debug_dyn_o rts/dist/build/StgPrimFloat.debug_dyn_o rts/dist/build/STM.debug_dyn_o rts/dist/build/Task.debug_dyn_o rts/dist/build/ThreadLabels.debug_dyn_o rts/dist/build/ThreadPaused.debug_dyn_o rts/dist/build/Threads.debug_dyn_o rts/dist/build/Ticky.debug_dyn_o rts/dist/build/Timer.debug_dyn_o rts/dist/build/Trace.debug_dyn_o rts/dist/build/Weak.debug_dyn_o rts/dist/build/WSDeque.debug_dyn_o rts/dist/build/hooks/FlagDefaults.debug_dyn_o rts/dist/build/hooks/MallocFail.debug_dyn_o rts/dist/build/hooks/OnExit.debug_dyn_o rts/dist/build/hooks/OutOfHeap.debug_dyn_o rts/dist/build/hooks/StackOverflow.debug_dyn_o rts/dist/build/sm/BlockAlloc.debug_dyn_o rts/dist/build/sm/Compact.debug_dyn_o rts/dist/build/sm/Evac.debug_dyn_o rts/dist/build/sm/GCAux.debug_dyn_o rts/dist/build/sm/GC.debug_dyn_o rts/dist/build/sm/GCUtils.debug_dyn_o rts/dist/build/sm/MarkWeak.debug_dyn_o rts/dist/build/sm/MBlock.debug_dyn_o rts/dist/build/sm/Sanity.debug_dyn_o rts/dist/build/sm/Scav.debug_dyn_o rts/dist/build/sm/Storage.debug_dyn_o rts/dist/build/sm/Sweep.debug_dyn_o rts/dist/build/eventlog/EventLog.debug_dyn_o rts/dist/build/posix/GetEnv.debug_dyn_o rts/dist/build/posix/GetTime.debug_dyn_o rts/dist/build/posix/Itimer.debug_dyn_o rts/dist/build/posix/OSMem.debug_dyn_o rts/dist/build/posix/OSThreads.debug_dyn_o rts/dist/build/posix/Select.debug_dyn_o rts/dist/build/posix/Signals.debug_dyn_o rts/dist/build/posix/TTY.debug_dyn_o rts/dist/build/Apply.debug_dyn_o rts/dist/build/Exception.debug_dyn_o rts/dist/build/HeapStackCheck.debug_dyn_o rts/dist/build/PrimOps.debug_dyn_o rts/dist/build/StgMiscClosures.debug_dyn_o rts/dist/build/StgStartup.debug_dyn_o rts/dist/build/StgStdThunks.debug_dyn_o rts/dist/build/Updates.debug_dyn_o rts/dist/build/AutoApply.debug_dyn_o -o rts/dist/build/libHSrts_debug-ghc7.7.20130402.so /usr/bin/ld: rts/dist/build/Schedule.dyn_o: relocation R_X86_64_PC32 against `StgRun' can not be used when making a shared object; recompile with -fPIC /usr/bin/ld: final link failed: Bad value collect2: ld returned 1 exit status Apparently stage1 builds fine, not sure what can cause this. Any idea? Cheers, Gabor

3 2

Overlapping families (specificity/degrees of freedom)
by Gabor Greif 03 Apr '13

03 Apr '13

Hi Richard, I have a question regarding type families with overlapping syntax. In below example the last two lines are overlapped, so the first gets selected when I present type equality witness to GHC: > help :: Sing (ls :: Inventory a) -> Sing (r :: Inventory a) -> Sing (l :: a) -> Sing (InterAppend ls r l) > help l@(Snoc _ _) (Snoc _ r) one | Just Eq <- isSame r one = Snoc l one --- OKAY > type family InterAppend (l' :: Inventory a) (r' :: Inventory a) (one' :: a) :: Inventory a > type instance where > InterAppend Empty r one = Empty > InterAppend (More ls l) Empty one = Empty > InterAppend (More ls l) (More rs one) one = More (More ls l) one --- 4 degrees of freedom > InterAppend (More ls l) (More rs r) one = More ls l --- 5 degrees of freedom However I cannot manage to trigger the last line when *not* presenting the witness, e.g. in this case: > help l@(Snoc _ _) (Snoc _ _) _ = l --- DOES NOT WORK IIRC, when implementing something like this in Omega, the type function evaluator considered the number of type variables and tried to match the more constrained leg (i.e. preferred less degrees of freedom). Can you give me a hint how this is supposed to work in your implementation? Must I present a type non-equality witness to trigger the fourth leg of InterAppend above? What I am trying to implement is an intersection algorithm for singleton-typed list witnesses, roughly > intersect :: SingEqual (t :: a) => Sing (lhs :: '[a]) -> Sing (rhs :: '[a]) -> Sing (Intersect lhs rhs) ... but I am not there yet, obviously! I'd be grateful for any hint, cheers, Gabor

3 5

Proxy, new Typeable, and type-level equality
by Richard Eisenberg 03 Apr '13

03 Apr '13

Hi all, Combining ideas from a number of people/threads ("Proxy and new-typeable" [on libraries] and "RFC: Singleton equality witnesses" [on ghc-devs]), I propose this: > module GHC.TypeReasoning where > > data a :~: b where > Refl :: a :~: a > > -- with credit to Conal Elliott for 'ty' and Erik Hesselink & Martijn van Steenbergen for 'type-equality' > sym :: (a :~: b) -> (b :~: a) > trans :: (a :~: b) -> (b :~: c) -> (a :~: c) > coerce :: (a :~: b) -> a -> b > liftEq :: (a :~: b) -> (f a :~: f b) > liftEq2 :: (a :~: a') -> (b :~: b') -> (f a b :~: f a' b') > liftEq3 :: ... > liftEq4 :: ... > > instance Eq (a :~: b) where ... > instance Show (a :~: b) where ... > instance Read (a :~: a) where ... > instance Ord (a :~: b) where ... > -- what other instances? > > data Void > -- instances as in Edward Kmett's 'void' package > > absurd :: Void -> a > > type Refuted a = a -> Void > type Decision a = Proved a > | Disproved (Refuted a) > > class EqT f where > eqT :: f a -> f b -> Maybe (a :~: b) > > class EqT f => DecideEqT f where > decideEqT :: f a -> f b -> Decision (a :~: b) > > defaultEqT :: DecideEqT f => f a -> f b -> Maybe (a :~: b) -- for easy writing of EqT instances > > instance EqT ((:~:) a) where ... > instance DecideEqT ((:~:) a) where ... > module Data.Proxy where > -- as in Ben Gamari's version > module Data.Typeable ( … , Proxy(..), (:~:)(..) ) where > > ... > import GHC.TypeReasoning > import {-# SOURCE #-} Data.Proxy > > ... > eqTypeable :: (Typeable a, Typeable b) => Maybe (a :~: b) > decideEqTypeable :: (Typeable a, Typeable b) => Decision (a :~: b) > -- can't use EqT and DecideEqT because Typeable is in Constraint, not * > > gcast :: (Typeable a, Typeable b) => c a -> Maybe (c b) -- it is now polykinded > > {-# DEPRECATED gcast1 ... #-} > {-# DEPRECATED gcast2 ... #-} > ... On top of features others have proposed/written in packages, I have added DecideEqT and related definitions. I would indeed have use for this definition, and I imagine others will, too, once it's out there. We could theoretically hold off on that one, but it seems easy enough just to put it in now, while we're all thinking about it. I've tested the definition by writing instances of singletons, and it works as desired. If this proposal is accepted, we can then look at changing some of the definitions around TypeLits as well, linking in much of the ghc-devs thread "RFC: Singleton equality witnesses". I don't see any dependencies from the code above on the TypeLits/singleton stuff, so I think we can take those changes in a second round. One question in the above code: What other instances should there be for (:~:)? Comments? Thoughts? Thanks, Richard

2 1

RE: [commit: ghc] master: Fix non-termination of SpecConstr (see #5550). ForceSpecConstr will now only specialise recursive types a finite number of times. There is a new option -fspec-constr-recursive, with a default value of 3. (81d55a9)
by Simon Peyton-Jones 03 Apr '13

03 Apr '13

Amos Thanks for doing this. Could you pls add a Note [Limit recursive specialisation] in SpecConstr, that explains (a) the problem, with an example, and (b) the solution. Plus, mention the relevant Trac tickets. It'll take you a few minutes to write, but it's worth it. That way in five years time, when your successor is staring at your code, he or she will have an insight into your thinking. Also is there a test case you can give, in the testsuite, which sends GHC into a loop without it, but works fine with it? Thanks Simon | -----Original Message----- | From: ghc-commits-bounces(a)haskell.org [mailto:ghc-commits- | bounces(a)haskell.org] On Behalf Of Amos Robinson | Sent: 28 March 2013 04:25 | To: ghc-commits(a)haskell.org | Subject: [commit: ghc] master: Fix non-termination of SpecConstr (see | #5550). ForceSpecConstr will now only specialise recursive types a | finite number of times. There is a new option -fspec-constr-recursive, | with a default value of 3. (81d55a9) | | Repository : http://darcs.haskell.org/ghc.git/ | | On branch : master | | https://github.com/ghc/ghc/commit/81d55a9ec28d9d7c8b1492516ebd58c5ff90c0 | e8 | | >--------------------------------------------------------------- | | commit 81d55a9ec28d9d7c8b1492516ebd58c5ff90c0e8 | Author: Amos Robinson <amos.robinson(a)gmail.com> | Date: Thu Mar 28 12:37:42 2013 +1100 | | Fix non-termination of SpecConstr (see #5550). | ForceSpecConstr will now only specialise recursive types a finite | number of times. | There is a new option -fspec-constr-recursive, with a default value | of 3. | | >--------------------------------------------------------------- | | compiler/main/DynFlags.hs | 4 +++ | compiler/specialise/SpecConstr.lhs | 64 +++++++++++++++++++++++++++---- | ------- | 2 files changed, 50 insertions(+), 18 deletions(-) | | diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index | 3c82fd0..2f76c35 100644 | --- a/compiler/main/DynFlags.hs | +++ b/compiler/main/DynFlags.hs | @@ -569,6 +569,8 @@ data DynFlags = DynFlags { | simplTickFactor :: Int, -- ^ Multiplier for simplifier | ticks | specConstrThreshold :: Maybe Int, -- ^ Threshold for SpecConstr | specConstrCount :: Maybe Int, -- ^ Max number of | specialisations for any one function | + specConstrRecursive :: Int, -- ^ Max number of | specialisations for recursive types | + -- Not optional; otherwise | ForceSpecConstr can diverge. | liberateCaseThreshold :: Maybe Int, -- ^ Threshold for LiberateCase | floatLamArgs :: Maybe Int, -- ^ Arg count for lambda | floating | -- See | CoreMonad.FloatOutSwitches | @@ -1217,6 +1219,7 @@ defaultDynFlags mySettings = | simplTickFactor = 100, | specConstrThreshold = Just 2000, | specConstrCount = Just 3, | + specConstrRecursive = 3, | liberateCaseThreshold = Just 2000, | floatLamArgs = Just 0, -- Default: float only if no | fvs | historySize = 20, | @@ -2227,6 +2230,7 @@ dynamic_flags = [ | , Flag "fno-spec-constr-threshold" (noArg (\d -> d{ | specConstrThreshold = Nothing })) | , Flag "fspec-constr-count" (intSuffix (\n d -> d{ | specConstrCount = Just n })) | , Flag "fno-spec-constr-count" (noArg (\d -> d{ specConstrCount | = Nothing })) | + , Flag "fspec-constr-recursive" (intSuffix (\n d -> d{ | specConstrRecursive = n })) | , Flag "fliberate-case-threshold" (intSuffix (\n d -> d{ | liberateCaseThreshold = Just n })) | , Flag "fno-liberate-case-threshold" (noArg (\d -> d{ | liberateCaseThreshold = Nothing })) | , Flag "frule-check" (sepArg (\s d -> d{ ruleCheck = | Just s })) | diff --git a/compiler/specialise/SpecConstr.lhs | b/compiler/specialise/SpecConstr.lhs | index c02b34a..d03baf0 100644 | --- a/compiler/specialise/SpecConstr.lhs | +++ b/compiler/specialise/SpecConstr.lhs | @@ -31,6 +31,7 @@ import DataCon | import Coercion hiding( substTy, substCo ) | import Rules | import Type hiding ( substTy ) | +import TyCon ( isRecursiveTyCon ) | import Id | import MkCore ( mkImpossibleExpr ) | import Var | @@ -457,6 +458,8 @@ sc_force to True when calling specLoop. This flag | does three things: | (see specialise) | * Specialise even for arguments that are not scrutinised in the loop | (see argToPat; Trac #4488) | + * Only specialise on recursive types a finite number of times | + (see is_too_recursive; Trac #5550) | | This flag is inherited for nested non-recursive bindings (which are | likely to be join points and hence should be fully specialised) but | reset for nested @@ -619,21 +622,25 @@ specConstrProgram guts | | %*********************************************************************** | * | | \begin{code} | -data ScEnv = SCE { sc_dflags :: DynFlags, | - sc_size :: Maybe Int, -- Size threshold | - sc_count :: Maybe Int, -- Max # of | specialisations for any one fn | +data ScEnv = SCE { sc_dflags :: DynFlags, | + sc_size :: Maybe Int, -- Size threshold | + sc_count :: Maybe Int, -- Max # of | specialisations for any one fn | -- See Note [Avoiding | exponential blowup] | - sc_force :: Bool, -- Force | specialisation? | + | + sc_recursive :: Int, -- Max # of | specialisations over recursive type. | + -- Stops | ForceSpecConstr from diverging. | + | + sc_force :: Bool, -- Force | specialisation? | -- See Note [Forcing | specialisation] | | - sc_subst :: Subst, -- Current substitution | + sc_subst :: Subst, -- Current substitution | -- Maps InIds to | OutExprs | | sc_how_bound :: HowBoundEnv, | -- Binds interesting non-top-level variables | -- Domain is OutVars (*after* applying the | substitution) | | - sc_vals :: ValueEnv, | + sc_vals :: ValueEnv, | -- Domain is OutIds (*after* applying the | substitution) | -- Used even for top-level bindings (but not | imported ones) | | @@ -665,13 +672,14 @@ instance Outputable Value where | --------------------- | initScEnv :: DynFlags -> UniqFM SpecConstrAnnotation -> ScEnv | initScEnv dflags anns | - = SCE { sc_dflags = dflags, | - sc_size = specConstrThreshold dflags, | - sc_count = specConstrCount dflags, | - sc_force = False, | - sc_subst = emptySubst, | - sc_how_bound = emptyVarEnv, | - sc_vals = emptyVarEnv, | + = SCE { sc_dflags = dflags, | + sc_size = specConstrThreshold dflags, | + sc_count = specConstrCount dflags, | + sc_recursive = specConstrRecursive dflags, | + sc_force = False, | + sc_subst = emptySubst, | + sc_how_bound = emptyVarEnv, | + sc_vals = emptyVarEnv, | sc_annotations = anns } | | data HowBound = RecFun -- These are the recursive functions for which | @@ -1518,15 +1526,35 @@ callsToPats :: ScEnv -> [OneSpec] -> [ArgOcc] -> | [Call] -> UniqSM (Bool, [CallPa callsToPats env done_specs bndr_occs | calls | = do { mb_pats <- mapM (callToPats env bndr_occs) calls | | - ; let good_pats :: [CallPat] | + ; let good_pats :: [(CallPat, ValueEnv)] | good_pats = catMaybes mb_pats | done_pats = [p | OS p _ _ _ <- done_specs] | is_done p = any (samePat p) done_pats | + no_recursive = map fst (filterOut (is_too_recursive env) | + good_pats) | | ; return (any isNothing mb_pats, | - filterOut is_done (nubBy samePat good_pats)) } | + filterOut is_done (nubBy samePat no_recursive)) } | + | +is_too_recursive :: ScEnv -> (CallPat, ValueEnv) -> Bool | + -- Count the number of recursive constructors in a call pattern, | + -- filter out if there are more than the maximum. | + -- This is only necessary if ForceSpecConstr is in effect: | + -- otherwise specConstrCount will cause specialisation to | terminate. | +is_too_recursive env ((_,exprs), val_env) = sc_force env && maximum | +(map go exprs) > sc_recursive env where | + go e | + | Just (ConVal (DataAlt dc) args) <- isValue val_env e | + , isRecursiveTyCon (dataConTyCon dc) | + = 1 + sum (map go args) | + | + |App f a <- e | + = go f + go a | + | + | otherwise | + = 0 | | -callToPats :: ScEnv -> [ArgOcc] -> Call -> UniqSM (Maybe CallPat) | +callToPats :: ScEnv -> [ArgOcc] -> Call -> UniqSM (Maybe (CallPat, | +ValueEnv)) | -- The [Var] is the variables to quantify over in the rule | -- Type variables come first, since they may scope | -- over the following term variables | @@ -1553,9 +1581,9 @@ callToPats env bndr_occs (con_env, args) | sanitise id = id `setIdType` expandTypeSynonyms (idType | id) | -- See Note [Free type variables of the qvar types] | | - ; -- pprTrace "callToPats" (ppr args $$ ppr prs $$ ppr | bndr_occs) $ | + ; -- pprTrace "callToPats" (ppr args $$ ppr bndr_occs) $ | if interesting | - then return (Just (qvars', pats)) | + then return (Just ((qvars', pats), con_env)) | else return Nothing } | | -- argToPat takes an actual argument, and returns an abstracted | | | | _______________________________________________ | ghc-commits mailing list | ghc-commits(a)haskell.org | http://www.haskell.org/mailman/listinfo/ghc-commits

2 2

Fwd: Crash on Windows with large data
by Yitzchak Gale 02 Apr '13

02 Apr '13

Please forgive me if you received this message twice. I believe that my first attempt to send it was swallowed due to my not being a subscriber to the list at that time. We now have a Windows server with 23 GB of memory temporarily available this week to work on this GHC crash. Is there anyone interested in having a look at the problem? Quick review: We have a proprietary app which crashes on Windows with a BEX64 error when it processes input data that causes it to use more than about 4 GB of RAM. The same program when processing the same data runs to successful completion on Linux. Jason offered evidence that perhaps this is a general problem with the RTS on Windows when more than 4 GB of RAM is consumed. Further information: We are using 7.6.2 64-bit on Windows, and 7.4.2 (Haskell Platform) on Linux. Our program also requires quite a bit of stack when processing that large data. I give it 128 MB. I just tried reproducing this problem by running a simple program that eats up lots of memory. First I used a list, then I tried "chopping things up" more by using a rose tree. In both cases, I also tried creating an intentional memory leak to eat up lots of stack. None of that succeeded in reproducing the crash. I wouldn't eliminate Jason's hypothesis just yet, but so far it looks like it's not quite that simple. Any ideas? Thanks, Yitz

1 0

build failure on FreeBSD 9.1
by Kazu Yamamoto 02 Apr '13

02 Apr '13

Hi, GHC head cannot be build on FreeBSD 9.1: ---- libraries/hpc/ghc.mk:3: libraries/hpc/dist-boot/build/.depend-v.haskell: No such file or directory compiler/ghc.mk:426: compiler/stage1/build/.depend-v.haskell: No such file or directory "cp" -p utils/hsc2hs/dist/build/tmp/hsc2hs inplace/lib/bin/hsc2hs utils/hsc2hs/ghc.mk:15: *** Do not know how to prependLibraryPath on freebsd. Stop. gmake: *** [all] Error 2 ---- I can build GHC head on Linux. --Kazu

3 19