Simon Peyton Jones pushed to branch wip/spj-try-opt-coercion at Glasgow Haskell Compiler / GHC

Commits:

1 changed file:

Changes:

  • compiler/GHC/Core/Coercion/Opt.hs
    ... ... @@ -11,7 +11,7 @@ import GHC.Tc.Utils.TcType ( exactTyCoVarsOfType )
    11 11
     import GHC.Core
    
    12 12
     import GHC.Core.TyCo.Rep
    
    13 13
     import GHC.Core.TyCo.Subst
    
    14
    -import GHC.Core.TyCo.Compare( eqForAllVis, eqTypeIgnoringMultiplicity, eqType )
    
    14
    +import GHC.Core.TyCo.Compare
    
    15 15
     import GHC.Core.Coercion
    
    16 16
     import GHC.Core.Type as Type hiding( substTyVarBndr, substTy )
    
    17 17
     import GHC.Core.TyCon
    
    ... ... @@ -297,20 +297,22 @@ opt_co_refl subst co = go co
    297 297
           = h { ch_co_var = updateVarType go_ty cv }
    
    298 298
     
    
    299 299
         go (Refl ty)                     = Refl (substTy subst ty)
    
    300
    -    go (GRefl r ty mco)              = GRefl r (go_ty ty) (go_m mco)
    
    300
    +    go (GRefl r ty mco)              = GRefl r $!! go_ty ty $!! go_m mco
    
    301 301
         go (CoVarCo cv)                  = substCoVar subst cv
    
    302 302
         go (HoleCo h)                    = HoleCo $!! go_hole h
    
    303
    -    go (SymCo co)                    = mkSymCo (go co)
    
    304
    -    go (KindCo co)                   = mkKindCo (go co)
    
    305
    -    go (SubCo co)                    = mkSubCo (go co)
    
    306
    -    go (SelCo n co)                  = mkSelCo n (go co)
    
    307
    -    go (LRCo n co)                   = mkLRCo n (go co)
    
    308
    -    go (AppCo co1 co2)               = mkAppCo (go co1) (go co2)
    
    309
    -    go (InstCo co1 co2)              = mkInstCo (go co1) (go co2)
    
    310
    -    go (FunCo r afl afr com coa cor) = mkFunCo2 r afl afr (go com) (go coa) (go cor)
    
    311
    -    go (TyConAppCo r tc cos)         = mkTyConAppCo r tc (go_s cos)
    
    312
    -    go (UnivCo p r lt rt cos)        = mkUnivCo p (go_s cos) r lt rt
    
    313
    -    go (AxiomCo ax cos)              = mkAxiomCo ax (go_s cos)
    
    303
    +    go (SymCo co)                    = mkSymCo $!! go co
    
    304
    +    go (KindCo co)                   = mkKindCo $!! go co
    
    305
    +    go (SubCo co)                    = mkSubCo $!! go co
    
    306
    +    go (SelCo n co)                  = mkSelCo n $!! go co
    
    307
    +    go (LRCo n co)                   = mkLRCo n $!! go co
    
    308
    +    go (AppCo co1 co2)               = mkAppCo  $!! go co1 $!! go co2
    
    309
    +    go (InstCo co1 co2)              = mkInstCo $!! go co1 $!! go co2
    
    310
    +    go (FunCo r afl afr com coa cor) = mkFunCo2 r afl afr
    
    311
    +                                           $!! go com $!! go coa $!! go cor
    
    312
    +    go (TyConAppCo r tc cos)         = mkTyConAppCo r tc $!! go_s cos
    
    313
    +    go (UnivCo p r lt rt cos)        = mkUnivCo p $!! (go_s cos) $!! r
    
    314
    +                                                  $!! (go_ty lt) $!! (go_ty rt)
    
    315
    +    go (AxiomCo ax cos)              = mkAxiomCo ax $!! (go_s cos)
    
    314 316
     
    
    315 317
         go (ForAllCo v vl vr mco co)     = mkForAllCo v' vl vr
    
    316 318
                                                $!! go_m mco