diff options
| author | Ben Gamari <bgamari.foss@gmail.com> | 2017-08-16 19:01:59 -0400 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2017-08-16 19:02:28 -0400 |
| commit | b0ed07fafbe96c3eee6c7f41ef937973bedbf1dc (patch) | |
| tree | 39453178a4c27703e0387a2edca3841862ef2b71 | |
| parent | a8da0de27e600211f04601ac737c329d6603c700 (diff) | |
| download | haskell-b0ed07fafbe96c3eee6c7f41ef937973bedbf1dc.tar.gz | |
Allow TcDerivInfer to compile with GHC 8.0.1
As of ed7a830de6a2ea74dd6bb81f8ec55b9fe0b52f28 this module uses
MultiWayIf, the parsing behavior of which changed in 8.0.2 due
to #10807. Reformat the code so that it compiles under both 8.0.1 and
8.0.2/8.2.1.
Test Plan: Validate bootstrapping with 8.0.1
Reviewers: austin
Subscribers: rwbarton, thomie, RyanGlScott
GHC Trac Issues: #14130
Differential Revision: https://phabricator.haskell.org/D3863
| -rw-r--r-- | compiler/typecheck/TcDerivInfer.hs | 42 |
1 files changed, 21 insertions, 21 deletions
diff --git a/compiler/typecheck/TcDerivInfer.hs b/compiler/typecheck/TcDerivInfer.hs index 85ff250d81..81bbfd94b4 100644 --- a/compiler/typecheck/TcDerivInfer.hs +++ b/compiler/typecheck/TcDerivInfer.hs @@ -247,34 +247,34 @@ inferConstraintsDataConArgs inst_ty inst_tys if -- Generic constraints are easy | is_generic - -> return ([], tvs, inst_tys) + -> return ([], tvs, inst_tys) -- Generic1 needs Functor -- See Note [Getting base classes] | is_generic1 - -> ASSERT( rep_tc_tvs `lengthExceeds` 0 ) - -- Generic1 has a single kind variable - ASSERT( cls_tys `lengthIs` 1 ) - do { functorClass <- lift $ tcLookupClass functorClassName - ; pure $ con_arg_constraints - $ get_gen1_constraints functorClass } + -> ASSERT( rep_tc_tvs `lengthExceeds` 0 ) + -- Generic1 has a single kind variable + ASSERT( cls_tys `lengthIs` 1 ) + do { functorClass <- lift $ tcLookupClass functorClassName + ; pure $ con_arg_constraints + $ get_gen1_constraints functorClass } -- The others are a bit more complicated | otherwise - -> -- See the comment with all_rep_tc_args for an explanation of - -- this assertion - ASSERT2( equalLength rep_tc_tvs all_rep_tc_args - , ppr main_cls <+> ppr rep_tc - $$ ppr rep_tc_tvs $$ ppr all_rep_tc_args ) - do { let (arg_constraints, tvs', inst_tys') - = con_arg_constraints get_std_constrained_tys - ; lift $ traceTc "inferConstraintsDataConArgs" $ vcat - [ ppr main_cls <+> ppr inst_tys' - , ppr arg_constraints - ] - ; return ( stupid_constraints ++ extra_constraints - ++ arg_constraints - , tvs', inst_tys') } + -> -- See the comment with all_rep_tc_args for an explanation of + -- this assertion + ASSERT2( equalLength rep_tc_tvs all_rep_tc_args + , ppr main_cls <+> ppr rep_tc + $$ ppr rep_tc_tvs $$ ppr all_rep_tc_args ) + do { let (arg_constraints, tvs', inst_tys') + = con_arg_constraints get_std_constrained_tys + ; lift $ traceTc "inferConstraintsDataConArgs" $ vcat + [ ppr main_cls <+> ppr inst_tys' + , ppr arg_constraints + ] + ; return ( stupid_constraints ++ extra_constraints + ++ arg_constraints + , tvs', inst_tys') } typeToTypeKind :: Kind typeToTypeKind = liftedTypeKind `mkFunTy` liftedTypeKind |