Whitespace only
authorIan Lynagh <igloo@earth.li>
Tue, 24 Nov 2009 00:32:21 +0000 (00:32 +0000)
committerIan Lynagh <igloo@earth.li>
Tue, 24 Nov 2009 00:32:21 +0000 (00:32 +0000)
compiler/typecheck/TcGenDeriv.lhs

index 8bbc27a..bcf1f07 100644 (file)
@@ -311,75 +311,80 @@ gen_Ord_binds loc tycon
   | Just (con, prim_tc) <- primWrapperType_maybe tycon
   = gen_PrimOrd_binds con prim_tc
 
-  | otherwise 
+  | otherwise
   = (unitBag compare, aux_binds)
-       -- `AndMonoBinds` compare       
-       -- The default declaration in PrelBase handles this
+        -- `AndMonoBinds` compare
+        -- The default declaration in PrelBase handles this
   where
     aux_binds | single_con_type = []
-             | otherwise       = [GenCon2Tag tycon]
+              | otherwise       = [GenCon2Tag tycon]
 
     compare = L loc (mkFunBind (L loc compare_RDR) compare_matches)
     compare_matches = [mkMatch [a_Pat, b_Pat] compare_rhs cmp_eq_binds]
     cmp_eq_binds    = HsValBinds (ValBindsIn (unitBag cmp_eq) [])
 
     compare_rhs
-       | single_con_type = cmp_eq_Expr a_Expr b_Expr
-       | otherwise
-       = untag_Expr tycon [(a_RDR, ah_RDR), (b_RDR, bh_RDR)]
-                 (cmp_tags_Expr eqInt_RDR ah_RDR bh_RDR
-                       (cmp_eq_Expr a_Expr b_Expr)     -- True case
-                       -- False case; they aren't equal
-                       -- So we need to do a less-than comparison on the tags
-                       (cmp_tags_Expr ltInt_RDR ah_RDR bh_RDR ltTag_Expr gtTag_Expr))
+        | single_con_type = cmp_eq_Expr a_Expr b_Expr
+        | otherwise
+        = untag_Expr tycon [(a_RDR, ah_RDR), (b_RDR, bh_RDR)]
+                  (cmp_tags_Expr eqInt_RDR ah_RDR bh_RDR
+                        (cmp_eq_Expr a_Expr b_Expr)     -- True case
+                        -- False case; they aren't equal
+                        -- So we need to do a less-than comparison on the tags
+                        (cmp_tags_Expr ltInt_RDR ah_RDR bh_RDR
+                                       ltTag_Expr gtTag_Expr))
 
     tycon_data_cons = tyConDataCons tycon
     single_con_type = isSingleton tycon_data_cons
     (nullary_cons, nonnullary_cons)
        | isNewTyCon tycon = ([], tyConDataCons tycon)
-       | otherwise       = partition isNullarySrcDataCon tycon_data_cons
+       | otherwise        = partition isNullarySrcDataCon tycon_data_cons
 
     cmp_eq = mk_FunBind loc cmp_eq_RDR cmp_eq_match
     cmp_eq_match
       | isEnumerationTyCon tycon
-                          -- We know the tags are equal, so if it's an enumeration TyCon,
-                          -- then there is nothing left to do
-                          -- Catch this specially to avoid warnings
-                          -- about overlapping patterns from the desugarer,
-                          -- and to avoid unnecessary pattern-matching
+                           -- We know the tags are equal, so if it's an
+                           -- enumeration TyCon,
+                           -- then there is nothing left to do
+                           -- Catch this specially to avoid warnings
+                           -- about overlapping patterns from the desugarer,
+                           -- and to avoid unnecessary pattern-matching
       = [([nlWildPat,nlWildPat], eqTag_Expr)]
       | otherwise
       = map pats_etc nonnullary_cons ++
-       (if single_con_type then        -- Omit wildcards when there's just one 
-             []                        -- constructor, to silence desugarer
-       else
+        (if single_con_type then        -- Omit wildcards when there's just one
+              []                        -- constructor, to silence desugarer
+        else
               [([nlWildPat, nlWildPat], default_rhs)])
 
-    default_rhs | null nullary_cons = impossible_Expr  -- Keep desugarer from complaining about
-                                                       -- inexhaustive patterns
-               | otherwise         = eqTag_Expr        -- Some nullary constructors;
-                                                       -- Tags are equal, no args => return EQ
+    default_rhs | null nullary_cons = -- Keep desugarer from complaining about
+                                      -- inexhaustive patterns
+                                      impossible_Expr
+                | otherwise         = -- Some nullary constructors;
+                                      -- Tags are equal, no args => return EQ
+                                      eqTag_Expr
     pats_etc data_con
-       = ([con1_pat, con2_pat],
-          nested_compare_expr tys_needed as_needed bs_needed)
-       where
-         con1_pat = nlConVarPat data_con_RDR as_needed
-         con2_pat = nlConVarPat data_con_RDR bs_needed
-
-         data_con_RDR = getRdrName data_con
-         con_arity   = length tys_needed
-         as_needed   = take con_arity as_RDRs
-         bs_needed   = take con_arity bs_RDRs
-         tys_needed  = dataConOrigArgTys data_con
-
-         nested_compare_expr [ty] [a] [b]
-           = careful_compare_Case tycon ty eqTag_Expr (nlHsVar a) (nlHsVar b)
-
-         nested_compare_expr (ty:tys) (a:as) (b:bs)
-           = let eq_expr = nested_compare_expr tys as bs
-               in  careful_compare_Case tycon ty eq_expr (nlHsVar a) (nlHsVar b)
-
-         nested_compare_expr _ _ _ = panic "nested_compare_expr"       -- Args always equal length
+        = ([con1_pat, con2_pat],
+           nested_compare_expr tys_needed as_needed bs_needed)
+        where
+          con1_pat = nlConVarPat data_con_RDR as_needed
+          con2_pat = nlConVarPat data_con_RDR bs_needed
+
+          data_con_RDR = getRdrName data_con
+          con_arity   = length tys_needed
+          as_needed   = take con_arity as_RDRs
+          bs_needed   = take con_arity bs_RDRs
+          tys_needed  = dataConOrigArgTys data_con
+
+          nested_compare_expr [ty] [a] [b]
+            = careful_compare_Case tycon ty eqTag_Expr (nlHsVar a) (nlHsVar b)
+
+          nested_compare_expr (ty:tys) (a:as) (b:bs)
+            = let eq_expr = nested_compare_expr tys as bs
+              in careful_compare_Case tycon ty eq_expr (nlHsVar a) (nlHsVar b)
+
+          -- Args always equal length
+          nested_compare_expr _ _ _ = panic "nested_compare_expr"
 \end{code}
 
 Note [Comparision of primitive types]