- 06 Sep, 2011 10 commits
-
-
batterseapower authored
Basically as documented in http://hackage.haskell.org/trac/ghc/wiki/KindFact, this patch adds a new kind Constraint such that: Show :: * -> Constraint (?x::Int) :: Constraint (Int ~ a) :: Constraint And you can write *any* type with kind Constraint to the left of (=>): even if that type is a type synonym, type variable, indexed type or so on. The following (somewhat related) changes are also made: 1. We now box equality evidence. This is required because we want to give (Int ~ a) the *lifted* kind Constraint 2. For similar reasons, implicit parameters can now only be of a lifted kind. (?x::Int#) => ty is now ruled out 3. Implicit parameter constraints are now allowed in superclasses and instance contexts (this just falls out as OK with the new constraint solver) Internally the following major changes were made: 1. There is now no PredTy in the Type data type. Instead GHC checks the kind of a type to figure out if it is a predicate 2. There is now no AClass TyThing: we represent classes as TyThings just as a ATyCon (classes had TyCons anyway) 3. What used to be (~) is now pretty-printed as (~#). The box constructor EqBox :: (a ~# b) -> (a ~ b) 4. The type LCoercion is used internally in the constraint solver and type checker to represent coercions with free variables of type (a ~ b) rather than (a ~# b)
-
batterseapower authored
This special case was introduced in 228c4743 to 'Fix problem with :i for (:)' but the associated Note doesn't explain why (:) deserves this treatment but not e.g. Left and Right. Removing the special case does not break anything (including :i (:)) so I guess this is no longer necessary. Conflicts: compiler/rename/RnEnv.lhs
-
batterseapower authored
-
batterseapower authored
Conflicts: compiler/simplCore/SetLevels.lhs
-
batterseapower authored
-
batterseapower authored
-
-
-
Simon Marlow authored
(#5441)
-
Simon Marlow authored
1c2f8953 (symptom was broken biographical profiling, see #5451).
-
- 05 Sep, 2011 7 commits
-
-
Simon Peyton Jones authored
-
Simon Peyton Jones authored
See Note [mkSelectorBinds]
-
Simon Peyton Jones authored
Fixes Trac #5456, which was a buglet arising from commit de9b85fa Author: Simon Peyton Jones <simonpj@microsoft.com> Date: Fri Sep 2 17:43:53 2011 +0100 Export a tiny bit more info with AbstractTyCon (fixes #5424) It only shows up when compiling with -O0!
-
Simon Peyton Jones authored
-
Simon Peyton Jones authored
The problem is documented in the ticket. The patch does two things 1. Make exprOkForSpeculation return False for a non-exhaustive case 2. In SetLevels.lvlExpr, look at the *result* scrutinee, not the *input* scrutinee, when testing for evaluated-ness
-
Simon Peyton Jones authored
-
Simon Peyton Jones authored
This was making Text.PrettyPrint.HughesPJ give a lint-bug when the libraries were compiled with -O2. It's all caused by phantom type synonyms (which are, generally speaking, a royal pain). The fix is simple, but a bit brutal. See Note [Free type variables of the qvar types].
-
- 02 Sep, 2011 9 commits
-
-
Simon Peyton Jones authored
When we compile -O0 we put type constructors in the interface file without their data constructors -- an AbstractTyCon. But in a client module, to give good pattern-match exhaustiveness warnings, we need to know the difference between a data type and a newtype. (The latter can be coerced to another type, but a data type can't.) See Note [Pruning dead case alternatives] in Unify. Because we weren't conveying this info, we were getting bogus warnings about inexhaustive patterm matches with GADTs, and (confusingly) these warnings woudl come and go depending on whether you were compiling with -O. This patch makes AbstractTyCon carry a flag indicating whether the type constructor is "distinct"; two distinct TyCons cannot be coerced into eachother (except by unsafeCoerce, in which case all bets are off). HEADS UP: interface file format changes slightly, so you need to make clean.
-
Simon Peyton Jones authored
I had second thoughts on the "data family export" question. Rather than add a wierd special case it seems better to be simple and consistent. So this patch * Reverts to the simple behaviour: module M where { ... } exports only what is defined in M, ie NOT any imported data families. See Note [Exports of data families] in RnNames * Documents this behaviour in the user manual, and clarifies what was there before.
-
-
Simon Peyton Jones authored
I found that an imported instance was getting printed with <no location info>. Fixing this pushed me into a bit more refactoring than I intended, but it's all small aesthetic stuff, nothing fundamental. Caused some error message to change as a result. I removed pprDefnLoc from the GHC API because it doesn't seem to be used. Name.pprNamedefnLoc and pprDefinedAt are probably more useful anyway.
-
Simon Peyton Jones authored
When constructing export lists, data families pose an awkward problem, documented in Note [Exports of data families] in RnNames. Consider module M where import X( D ) data instance D Int = M1 | M2 Here M exports M1 and M2, obviously, but does it export D? It would not usually do so, but if we don't then no one can import M selectively like this: import M( D(M1,M2) ) So we compromise and export D too. But I made two mistakes a) Didn't check for conflicts between the extra export of X.D and any other exports called "D" b) Did the extra export for imported things too, not just ones defined in this module (ie made the compromise apply much more widely than necessary) This made Programatica (a complex project) break in an obscure way; (b) caused an export conflict, (a) meant that the conflict was not spotted, which in turn caused later chaos. Anyway the fix is easy, and is documented in the Note.
-
Simon Peyton Jones authored
-
Simon Peyton Jones authored
thRdrName is used to construct *binders*, and some of them are Exact RdrNames, so we need to give them a decent source location.
-
Simon Peyton Jones authored
-
Simon Peyton Jones authored
This parameter controls the allowed depth of reasoning in the type constraint solver. Perfectly well-behaved programs can use deep stacks, and 20 is obviously too small. (Indeed, if you don't have UndecidableInstances, the constraint solver is supposed to terminate, so no limit should be needed.) Responding to Trac #5395 this patch increases the default to 200.
-
- 01 Sep, 2011 9 commits
-
-
Ian Lynagh authored
Allows you to turn off loading/storing the GHCi command history from/to the ~/.ghc/ghci_history file.
-
Simon Peyton Jones authored
Even if we are recovering from a typecheck error, we should still do the right thing for the "closed" flag. Otherwise we get an assert failure, and potentially different behaviour when the user fixes the original type error.
-
Simon Marlow authored
maskUninterruptible state instead of ordinary mask, due to a misinterpretation of the way the TSO_INTERRUPTIBLE flag works. Remarkably this must have been broken for quite some time. Indeed we even had a test that demonstrated the wrong behaviour (conc015a) but presumably I didn't look hard enough at the output to notice that it was wrong.
-
Simon Peyton Jones authored
a) Allow multiple AT decls for in a single instance b) Allow a free type parameter to be instantiated Example class C a where type T a x :: * data A data B instance C Int where type T Int A = Int type T Int B = Bool There is no reason to prohibit this, and as we move towards a proper kind system it may even be useful. I also updated the documentation to cover this change and the previous one of allowing free type parameters for associated families.
-
Simon Peyton Jones authored
For the bind_fvs field of FunBind/PatBind, we need to be careful to keep track of uses of all functions in this module (although not imported ones). Moreover in TcBinds.decideGeneralisationPlan we need to take note of uses of lexically scoped type variables. These two buglets led to a (useful) assertion failure in TcEnv.
-
Simon Peyton Jones authored
-
Simon Peyton Jones authored
We had the idea that you might be able to define a default instance for an associated type family, thus: class C a where type T a :: * type T a = a -> a It's an idea that makes sense, but it was only 10% implemented. This patch just removes that misleading 10%.
-
Simon Peyton Jones authored
See Note [Associated families and their parent class]
-
Simon Peyton Jones authored
This patch allows class C a where type T a b :: * instance C Int type T Int b = b -> b That is, T has a type index 'b' that is not one of the class variables. On the way I did a good deal of refactoring (as usual), especially in TcInstDcls.tcLocalInstDecl1, which checks for consistent instantiation of the class instance and the type instance. Less code, more expressiveness. See Note [Checking consistent instantiation]
-
- 31 Aug, 2011 4 commits
-
-
Ian Lynagh authored
-
Ian Lynagh authored
-
Ian Lynagh authored
-
Ian Lynagh authored
-
- 30 Aug, 2011 1 commit
-
-
Ian Lynagh authored
-