Skip to content

Instantly share code, notes, and snippets.

@rrnewton
Last active October 23, 2015 13:45
Show Gist options
  • Save rrnewton/1ac722189c65f26fe9ac to your computer and use it in GitHub Desktop.
Save rrnewton/1ac722189c65f26fe9ac to your computer and use it in GitHub Desktop.
Costs of laziness: Compiling a simple strict function over maybes
{-# LANGUAGE BangPatterns #-}
module Main where
{- Here we look at what happens to the caling conventions when a strictness
annotation is added. Is the body of `foo` able to assume the argument is
already in WHNF (caller-enforces the !x) or must the body of `foo` do the work
(callee-enforces !x)?
Based on the generated STG and CMM code, it seems that the latter is
currently the case.
-}
{-# NOINLINE foo #-}
foo :: Maybe Int -> Int
foo !x =
case x of
Just y -> y
main :: IO ()
main = print (foo (Just 3))
// RRN: Below is the body of foo. Here I believe it should
// be possible to omit everything before the "c3aO" label,
// IFF foo can assume its argument is already in WHNF.
==================== Optimised Cmm ====================
2015-10-23 00:34:34.031857 UTC
foo_entry() // [R2]
{ [(c3aO,
block_c3aO_info:
const S3aD_srt-block_c3aO_info+8;
const 0;
const 4294967328;),
(c3aY,
foo_info:
const S3aD_srt-foo_info+8;
const 4294967301;
const 0;
const 12884901903;)]
}
{offset
c3aY:
if ((Sp + -8) < SpLim) goto c3aZ; else goto c3b0;
c3aZ:
// nop
R1 = PicBaseReg + foo_closure;
call (I64[BaseReg - 8])(R2, R1) args: 8, res: 0, upd: 8;
c3b0:
I64[Sp - 8] = PicBaseReg + block_c3aO_info;
R1 = R2;
Sp = Sp - 8;
if (R1 & 7 != 0) goto c3aO; else goto c3aP;
c3aP:
call (I64[R1])(R1) returns to c3aO, args: 8, res: 8, upd: 8;
c3aO:
if (R1 & 7 >= 2) goto c3aW; else goto c3aX;
c3aW:
R1 = P64[R1 + 6] & (-8);
Sp = Sp + 8;
call (I64[R1])(R1) args: 8, res: 0, upd: 8;
c3aX:
R1 = PicBaseReg + lvl_r39S_closure;
Sp = Sp + 8;
call (I64[R1])(R1) args: 8, res: 0, upd: 8;
}
}
==================== Tidy Core ====================
2015-10-23 00:34:33.918129 UTC
Result size of Tidy Core = {terms: 45, types: 45, coercions: 9}
lvl_r39S :: Int
[GblId, Str=DmdType b]
lvl_r39S = patError @ Int "CostOfLaziness.hs:(9,3)-(10,14)|case"#
foo [InlPrag=NOINLINE] :: Maybe Int -> Int
[GblId, Arity=1, Str=DmdType <S,1*U>]
foo =
\ (x_amZ :: Maybe Int) ->
case x_amZ of _ [Occ=Dead] {
Nothing -> lvl_r39S;
Just y_an0 -> y_an0
}
main4 :: Int
[GblId,
Caf=NoCafRefs,
Str=DmdType,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
main4 = I# 3
main3 :: Maybe Int
[GblId,
Caf=NoCafRefs,
Str=DmdType,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
main3 = Just @ Int main4
main2 :: String
[GblId,
Str=DmdType,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False,
WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 90 30}]
main2 =
case foo main3 of _ [Occ=Dead] { I# ww3_a38B ->
case $wshowSignedInt 0 ww3_a38B ([] @ Char)
of _ [Occ=Dead] { (# ww5_a38F, ww6_a38G #) ->
: @ Char ww5_a38F ww6_a38G
}
}
main1 :: State# RealWorld -> (# State# RealWorld, () #)
[GblId,
Arity=1,
Str=DmdType <L,U>,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 40 0}]
main1 =
\ (eta_aRQ [OS=OneShot] :: State# RealWorld) ->
hPutStr2 stdout main2 True eta_aRQ
main :: IO ()
[GblId,
Arity=1,
Str=DmdType <L,U>,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)
Tmpl= main1
`cast` (Sym (NTCo:IO[0] <()>_R)
:: (State# RealWorld -> (# State# RealWorld, () #)) ~R# IO ())}]
main =
main1
`cast` (Sym (NTCo:IO[0] <()>_R)
:: (State# RealWorld -> (# State# RealWorld, () #)) ~R# IO ())
main5 :: State# RealWorld -> (# State# RealWorld, () #)
[GblId,
Arity=1,
Str=DmdType,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 60}]
main5 =
runMainIO1
@ ()
(main1
`cast` (Sym (NTCo:IO[0] <()>_R)
:: (State# RealWorld -> (# State# RealWorld, () #)) ~R# IO ()))
main :: IO ()
[GblId,
Arity=1,
Str=DmdType,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)
Tmpl= main5
`cast` (Sym (NTCo:IO[0] <()>_R)
:: (State# RealWorld -> (# State# RealWorld, () #)) ~R# IO ())}]
main =
main5
`cast` (Sym (NTCo:IO[0] <()>_R)
:: (State# RealWorld -> (# State# RealWorld, () #)) ~R# IO ())
==================== STG syntax: ====================
2015-10-23 00:34:33.935719 UTC
lvl_r39S :: Int
[GblId, Str=DmdType b] =
\u srt:SRT:[0e :-> patError] []
patError "CostOfLaziness.hs:(9,3)-(10,14)|case"#;
foo [InlPrag=NOINLINE] :: Maybe Int -> Int
[GblId, Arity=1, Str=DmdType <S,1*U>, Unf=OtherCon []] =
\r srt:SRT:[r39S :-> lvl_r39S] [x_s3a1]
case x_s3a1 of _ [Occ=Dead] {
Nothing -> lvl_r39S;
Just y_s3a3 [Occ=Once] -> y_s3a3;
};
main4 :: Int
[GblId, Caf=NoCafRefs, Str=DmdType, Unf=OtherCon []] =
NO_CCS I#! [3];
main3 :: Maybe Int
[GblId, Caf=NoCafRefs, Str=DmdType, Unf=OtherCon []] =
NO_CCS Just! [main4];
main2 :: String
[GblId, Str=DmdType] =
\u srt:SRT:[rkj :-> foo] []
case foo main3 of _ [Occ=Dead] {
I# ww3_s3a5 [Occ=Once] ->
case $wshowSignedInt 0 ww3_s3a5 [] of _ [Occ=Dead] {
(#,#) ww5_s3a7 [Occ=Once] ww6_s3a8 [Occ=Once] ->
: [ww5_s3a7 ww6_s3a8];
};
};
main1 :: State# RealWorld -> (# State# RealWorld, () #)
[GblId, Arity=1, Str=DmdType <L,U>, Unf=OtherCon []] =
\r srt:SRT:[rnK :-> hPutStr2, roT :-> stdout,
r39O :-> main2] [eta_s3a9]
hPutStr2 stdout main2 True eta_s3a9;
main :: IO ()
[GblId, Arity=1, Str=DmdType <L,U>, Unf=OtherCon []] =
\r srt:SRT:[r38i :-> main1] [eta_B1] main1 eta_B1;
main5 :: State# RealWorld -> (# State# RealWorld, () #)
[GblId, Arity=1, Str=DmdType, Unf=OtherCon []] =
\r srt:SRT:[rJG :-> runMainIO1, r38i :-> main1] [eta_B1]
runMainIO1 main1 eta_B1;
main :: IO ()
[GblId, Arity=1, Str=DmdType, Unf=OtherCon []] =
\r srt:SRT:[r39R :-> main5] [eta_B1] main5 eta_B1;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment