В последнее время я немного выполнял очистку кода, и в этом процессе был изменен (не совсем настоящий код):
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'
:
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
Очевидно, что они семантически идентичны. Тем не менее, более поздние прогоны значительно медленнее (я тестировал только изменение этих строк, чтобы убедиться, что это была настоящая причина). Глядя на сбрасываемое ядро, я не могу выявить каких-либо очевидных различий, а <$> оказывается вложенным в обоих. Почему GHC не может оптимизировать последнее для первого?
Следует отметить, что в моей программе есть несколько мест, которые могут быть записаны в любом случае, а влияние производительности <$> согласовано между ними (примерно половина секунды на).
Я удалил ядро для тестов, так как было ясно, что они идентичны. Итак, вот ядро для фактической функции.
Первый способ:
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
Второй способ:
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
