Deal correctly with infix type constructors in GADT decls

[ghc-hetmet.git] / compiler / deSugar / DsExpr.lhs

diff --git a/compiler/deSugar/DsExpr.lhs b/compiler/deSugar/DsExpr.lhs
index ec291b0..5fb0ec8 100644 (file)
--- a/compiler/deSugar/DsExpr.lhs
+++ b/compiler/deSugar/DsExpr.lhs
@@ -43,13 +43,13 @@ import TcHsSyn              ( hsPatType, mkVanillaTuplePat )
 
 import TcType          ( tcSplitAppTy, tcSplitFunTys, tcTyConAppTyCon, 
                          tcTyConAppArgs, isUnLiftedType, Type, mkAppTy )
-import Type            ( funArgTy, splitFunTys, isUnboxedTupleType, mkFunTy )
+import Type            ( splitFunTys, isUnboxedTupleType, mkFunTy )
 import CoreSyn
 import CoreUtils       ( exprType, mkIfThenElse, bindNonRec )
 
 import CostCentre      ( mkUserCC )
 import Id              ( Id, idType, idName, idDataCon )
-import PrelInfo                ( rEC_CON_ERROR_ID, iRREFUT_PAT_ERROR_ID )
+import PrelInfo                ( rEC_CON_ERROR_ID )
 import DataCon         ( DataCon, dataConWrapId, dataConFieldLabels, dataConInstOrigArgTys )
 import DataCon         ( isVanillaDataCon )
 import TyCon           ( FieldLabel, tyConDataCons )
@@ -85,7 +85,9 @@ dsValBinds (ValBindsOut binds _) body = foldrDs ds_val_bind body binds
 -------------------------
 dsIPBinds (IPBinds ip_binds dict_binds) body
   = do { prs <- dsLHsBinds dict_binds
-       ; let inner = foldr (\(x,r) e -> Let (NonRec x r) e) body prs 
+       ; let inner = Let (Rec prs) body
+               -- The dict bindings may not be in 
+               -- dependency order; hence Rec
        ; foldrDs ds_ip_bind inner ip_binds }
   where
     ds_ip_bind (L _ (IPBind n e)) body