Menu
I was performing a bit of cleanup on my code recently, and in the process changed this (not quite the real code):
read = act readSTRef test1 term i var = do t <- fromRTerm term v <- rep var ty <- v^!varType.read ts <- v^!terms.read let ts' = TL.toVector ts when (ty /= Void && V.length ts' == 1) . updateChild term t i $ ts' V.! 0 V.mapM_ substitute ts' to this:
read = act readSTRef test2 term i var = do t <- fromRTerm term v <- rep var ty <- v^!varType.read ts <- TL.toVector <$> v^!terms.read when (ty /= Void && V.length ts == 1) . updateChild term t i $ ts V.! 0 V.mapM_ substitute ts Obviously, these are semantically identical. However, the later runs significantly slower (I tested with only changing those lines to ensure that was the actual cause). Looking at the dumped core, I can't identify any obvious differences, and <$> appears to be inlined in both. Why can't GHC optimise the latter to the former?
I should note that there are multiple places in my program that could be written either way, and the performance impact of <$> is consistent between them (about half a second per ).
I've removed the core for the tests, since it was clear that they were identical. So, here is the core for the actual function.
First way:
case ipv5_X2Q6 of _ [Occ=Dead] { __DEFAULT -> case GHC.Prim.writeMutVar# @ s_aJBu @ TypeInferencer.Stage dt5_dMoe TypeInferencer.Substituted ipv4_X2Q4 of s2#_aP5h { __DEFAULT -> letrec { a15_sSPP [Occ=LoopBreaker] :: [GHC.Types.Int] -> [TypeInferencer.RNode s_aJBu] -> GHC.Prim.State# s_aJBu -> (# GHC.Prim.State# s_aJBu, () #) [LclId, Arity=3, Str=DmdType <S,1*U><L,1*U><L,U>] a15_sSPP = \ (ds_aPlu :: [GHC.Types.Int]) (_ys_aPlv :: [TypeInferencer.RNode s_aJBu]) (eta_B1 :: GHC.Prim.State# s_aJBu) -> case ds_aPlu of _ [Occ=Dead] { [] -> (# eta_B1, GHC.Tuple.() #); : ipv6_aPlA ipv7_aPlB -> case _ys_aPlv of _ [Occ=Dead] { [] -> (# eta_B1, GHC.Tuple.() #); : ipv8_aPlH ipv9_aPlI -> tick<substitute.go> case scc<substitute.go> (scctick<fromRNode> GHC.STRef.readSTRef1 @ s_aJBu @ (Data.Either.Either (TypeInferencer.Term s_aJBu) (TypeInferencer.Var s_aJBu)) (ipv8_aPlH `cast` (TypeInferencer.NTCo:RNode[0] <s_aJBu>_N :: TypeInferencer.RNode s_aJBu ~# GHC.STRef.STRef s_aJBu (Data.Either.Either (TypeInferencer.Term s_aJBu) (TypeInferencer.Var s_aJBu))))) eta_B1 of _ [Occ=Dead] { (# ipv10_X2DV, ipv11_X2DX #) -> case ipv11_X2DX of _ [Occ=Dead] { Data.Either.Left ds5_dLX6 -> case scc<substitute.go> a11_rYpY @ s_aJBu ipv8_aPlH ipv10_X2DV of _ [Occ=Dead] { (# ipv12_a2tf, ipv13_a2tg #) -> a15_sSPP ipv7_aPlB ipv9_aPlI ipv12_a2tf }; Data.Either.Right var_aJrt -> case scc<substitute.go> a14_sPTG ipv10_X2DV of _ [Occ=Dead] { (# ipv12_X2PP, ipv13_X2PR #) -> tick<rep> case scc<substitute.go> scc<rep> a4_rYnT @ s_aJBu var_aJrt ipv12_X2PP of _ [Occ=Dead] { (# ipv14_X2PW, ipv15_X2PY #) -> case scc<substitute.go> scc<rep> a3_rYnR @ s_aJBu ipv15_X2PY var_aJrt ipv14_X2PW of _ [Occ=Dead] { (# ipv16_X2Q0, ipv17_X2Q2 #) -> case ipv17_X2Q2 of _ [Occ=Dead] { TypeInferencer.Var dt6_dMth x1_XJka dt7_dMti dt8_dMtj dt9_dMtk dt10_dMtl dt11_dMtm -> case scc<substitute.go> GHC.Prim.readMutVar# @ s_aJBu @ TypeInferencer.VarType dt7_dMti ipv16_X2Q0 of _ [Occ=Dead] { (# ipv18_X2Qt, ipv19_X2Qv #) -> case scc<substitute.go> GHC.Prim.readMutVar# @ s_aJBu @ (TreeList.TreeList (TypeInferencer.RNode s_aJBu)) dt9_dMtk ipv18_X2Qt of _ [Occ=Dead] { (# ipv20_X2QL, ipv21_X2QN #) -> case scc<substitute.go> scctick<substitute.go.ts'> TreeList.toVector @ (TypeInferencer.RNode s_aJBu) ipv21_X2QN of _ [Occ=Dead] { Data.Vector.Vector ww1_sTzM ww2_sTzN ww3_sTzO -> tick<==> tick</=> case scc<substitute.go> let { $w$j_sTA0 :: GHC.Prim.State# s_aJBu -> (# GHC.Prim.State# s_aJBu, () #) [LclId, Arity=1, Str=DmdType <L,U>] $w$j_sTA0 = \ (w_sTzY :: GHC.Prim.State# s_aJBu) -> letrec { $s$wa_sWUL [Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.State# s_aJBu -> (# GHC.Prim.State# s_aJBu, () #) [LclId, Arity=2, Str=DmdType <L,U><L,U>] $s$wa_sWUL = \ (sc_sWUJ :: GHC.Prim.Int#) (sc1_sWUK :: GHC.Prim.State# s_aJBu) -> case GHC.Prim.tagToEnum# @ GHC.Types.Bool (GHC.Prim.>=# sc_sWUJ ww2_sTzN) of _ [Occ=Dead] { GHC.Types.False -> case GHC.Prim.indexArray# @ (TypeInferencer.RNode s_aJBu) ww3_sTzO (GHC.Prim.+# ww1_sTzM sc_sWUJ) of _ [Occ=Dead] { (# ipv22_aQSr #) -> case a11_rYpY @ s_aJBu ipv22_aQSr sc1_sWUK of _ [Occ=Dead] { (# ipv23_X2EL, ipv24_X2EN #) -> $s$wa_sWUL (GHC.Prim.+# sc_sWUJ 1) ipv23_X2EL } }; GHC.Types.True -> (# sc1_sWUK, GHC.Tuple.() #) }; } in $s$wa_sWUL 0 w_sTzY } in Second way:
case ipv5_X2Q6 of _ [Occ=Dead] { __DEFAULT -> case GHC.Prim.writeMutVar# @ s_aJBt @ TypeInferencer.Stage dt5_dMog TypeInferencer.Substituted ipv4_X2Q4 of s2#_aP5h { __DEFAULT -> letrec { a15_sSPP [Occ=LoopBreaker] :: [GHC.Types.Int] -> [TypeInferencer.RNode s_aJBt] -> GHC.Prim.State# s_aJBt -> (# GHC.Prim.State# s_aJBt, () #) [LclId, Arity=3, Str=DmdType <S,1*U><L,1*U><L,U>] a15_sSPP = \ (ds_aPlu :: [GHC.Types.Int]) (_ys_aPlv :: [TypeInferencer.RNode s_aJBt]) (eta_B1 :: GHC.Prim.State# s_aJBt) -> case ds_aPlu of _ [Occ=Dead] { [] -> (# eta_B1, GHC.Tuple.() #); : ipv6_aPlA ipv7_aPlB -> case _ys_aPlv of _ [Occ=Dead] { [] -> (# eta_B1, GHC.Tuple.() #); : ipv8_aPlH ipv9_aPlI -> tick<substitute.go> case scc<substitute.go> (scctick<fromRNode> GHC.STRef.readSTRef1 @ s_aJBt @ (Data.Either.Either (TypeInferencer.Term s_aJBt) (TypeInferencer.Var s_aJBt)) (ipv8_aPlH `cast` (TypeInferencer.NTCo:RNode[0] <s_aJBt>_N :: TypeInferencer.RNode s_aJBt ~# GHC.STRef.STRef s_aJBt (Data.Either.Either (TypeInferencer.Term s_aJBt) (TypeInferencer.Var s_aJBt))))) eta_B1 of _ [Occ=Dead] { (# ipv10_X2DV, ipv11_X2DX #) -> case ipv11_X2DX of _ [Occ=Dead] { Data.Either.Left ds5_dLX8 -> case scc<substitute.go> a11_rYpY @ s_aJBt ipv8_aPlH ipv10_X2DV of _ [Occ=Dead] { (# ipv12_a2tf, ipv13_a2tg #) -> a15_sSPP ipv7_aPlB ipv9_aPlI ipv12_a2tf }; Data.Either.Right var_aJrt -> case scc<substitute.go> a14_sPTG ipv10_X2DV of _ [Occ=Dead] { (# ipv12_X2PP, ipv13_X2PR #) -> tick<rep> case scc<substitute.go> scc<rep> a4_rYnT @ s_aJBt var_aJrt ipv12_X2PP of _ [Occ=Dead] { (# ipv14_X2PW, ipv15_X2PY #) -> case scc<substitute.go> scc<rep> a3_rYnR @ s_aJBt ipv15_X2PY var_aJrt ipv14_X2PW of _ [Occ=Dead] { (# ipv16_X2Q0, ipv17_X2Q2 #) -> case ipv17_X2Q2 of _ [Occ=Dead] { TypeInferencer.Var dt6_dMtj x1_XJka dt7_dMtk dt8_dMtl dt9_dMtm dt10_dMtn dt11_dMto -> case scc<substitute.go> GHC.Prim.readMutVar# @ s_aJBt @ TypeInferencer.VarType dt7_dMtk ipv16_X2Q0 of _ [Occ=Dead] { (# ipv18_X2Qt, ipv19_X2Qv #) -> case scc<substitute.go> GHC.Prim.readMutVar# @ s_aJBt @ (TreeList.TreeList (TypeInferencer.RNode s_aJBt)) dt9_dMtm ipv18_X2Qt of _ [Occ=Dead] { (# ipv20_a6bS, ipv21_a6bT #) -> case scc<substitute.go> TreeList.toVector @ (TypeInferencer.RNode s_aJBt) ipv21_a6bT of _ [Occ=Dead] { Data.Vector.Vector ww1_sTzM ww2_sTzN ww3_sTzO -> tick<==> tick</=> case scc<substitute.go> let { $w$j_sTA0 :: GHC.Prim.State# s_aJBt -> (# GHC.Prim.State# s_aJBt, () #) [LclId, Arity=1, Str=DmdType <L,U>] $w$j_sTA0 = \ (w_sTzY :: GHC.Prim.State# s_aJBt) -> letrec { $s$wa_sWUL [Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.State# s_aJBt -> (# GHC.Prim.State# s_aJBt, () #) [LclId, Arity=2, Str=DmdType <L,U><L,U>] $s$wa_sWUL = \ (sc_sWUJ :: GHC.Prim.Int#) (sc1_sWUK :: GHC.Prim.State# s_aJBt) -> case GHC.Prim.tagToEnum# @ GHC.Types.Bool (GHC.Prim.>=# sc_sWUJ ww2_sTzN) of _ [Occ=Dead] { GHC.Types.False -> case GHC.Prim.indexArray# @ (TypeInferencer.RNode s_aJBt) ww3_sTzO (GHC.Prim.+# ww1_sTzM sc_sWUJ) of _ [Occ=Dead] { (# ipv22_aQSr #) -> case a11_rYpY @ s_aJBt ipv22_aQSr sc1_sWUK of _ [Occ=Dead] { (# ipv23_X2EL, ipv24_X2EN #) -> $s$wa_sWUL (GHC.Prim.+# sc_sWUJ 1) ipv23_X2EL } }; GHC.Types.True -> (# sc1_sWUK, GHC.Tuple.() #) }; } in $s$wa_sWUL 0 w_sTzY } in 
774
I suppose to answer this question for posterity -- "when the program was built without profiling enabled, they ran exactly the same". This makes perfect sense as additional function calls that are inlined away nonetheless, when profiling is enabled, must leave some trace for a cost center.
Heisenberg's principle in action -- if we observe our program too closely, we end up changing it!
127
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With
