Skip to content

Instantly share code, notes, and snippets.

@NicolasT

NicolasT/core

Created November 3, 2011 16:34
Show Gist options
  • Save NicolasT/1336978 to your computer and use it in GitHub Desktop.
Save NicolasT/1336978 to your computer and use it in GitHub Desktop.
Download ZIP
Haskell fold over list of monadic actions
Raw
core
[1 of 1] Compiling IO ( io.hs, io.o )
8 Lets floated to top level; 0 Lets floated elsewhere; from 11 Lambda groups
8 Lets floated to top level; 0 Lets floated elsewhere; from 8 Lambda groups
Total ticks: 507
107 PreInlineUnconditionally
2 eta_B1
1 s_Xtc
1 s_Xth
1 s_Xtl
1 a_ad7
1 b_ad8
1 b'_ad9
1 $dFunctor_adr
1 $dMonad_ads
6 $dMonad_apG
6 f_apH
6 x_apI
1 x_apO
2 f_apR
2 x_apS
1 g_apY
1 k_aqn
1 z_aqo
2 m_aqU
2 ds_aqW
10 ds_asx
10 k_asy
3 s_asz
8 x_asI
4 s_asJ
1 f_aQh
2 x_aQi
1 s_aQj
1 ds_dpl
2 ds_dpq
1 n_dpy
1 lvl_ss6
1 lvl_ss7
1 lvl_ss8
1 lvl_ss9
1 lvl_ssa
1 lvl_ssb
1 lvl_ssc
1 lvl_ssd
1 lvl_sse
1 lvl_ssf
1 lvl_ssg
1 lvl_ssh
1 lvl_ssi
1 lvl_ssj
1 lvl_ssk
1 lvl_ssl
1 lvl_ssm
1 lvl_ssn
1 lvl_sso
1 lvl_ssp
1 lvl_ssq
1 a_sQe
1 a_sQw
1 a_sQA
41 PostInlineUnconditionally
1 x_XqJ
2 f_acN
2 z_acO
1 f_ad2
1 act_adu
1 $dFunctor_adP
1 $dMonad_adQ
2 $dMonad_adY
2 f_apM
4 g_apN
3 x_apO
2 k_aqV
3 $dShow_asR
3 x_asS
3 eta_asT
1 f_aQh
1 s_aQj
1 ds_dpm
1 c_dpx
2 act_srC
1 a_sQM
1 a_sQS
1 a_sQY
1 a_sR4
94 UnfoldingDone
1 build
10 bindIO
8 returnIO
3 System.IO.print
2 $
2 f_apM
6 Control.Monad.=<<
4 .
8 returnIO1
10 bindIO1
8 $fMonadIO_$creturn
2 $fMonadIO_$c>>
8 $fMonadIO_$c>>=
2 $fFunctorIO2
2 $fFunctorIO_$cfmap
2 IO.foldrM'
3 System.IO.print1
1 a_sr0
1 a_sr2
1 a_sr4
1 a_sr6
2 ds_srE
1 a_ss4
1 a_ssN
1 a_ssP
1 a_sQq
1 a_sQs
1 a_sQy
1 a_sQC
27 RuleFired
3 Class op +
2 Class op >>
8 Class op >>=
2 Class op fmap
8 Class op return
3 Class op show
1 foldr/nil
26 LetFloatFromLet
26
6 EtaExpansion
1 act_adu
1 IO.foldrM'
1 $sfoldrM'_sru
1 act_srx
2 act_srC
206 BetaReduction
2 eta_B1
1 x_XqJ
1 s_Xtc
1 s_Xth
1 s_Xtl
2 f_acN
2 z_acO
1 f_ad2
1 z_ad3
1 a_ad7
1 b_ad8
1 b'_ad9
1 m_ado
1 a_adp
1 b_adq
1 $dFunctor_adr
1 $dMonad_ads
1 m_adO
1 $dFunctor_adP
1 $dMonad_adQ
2 m_adV
2 a_adW
2 b_adX
2 $dMonad_adY
6 m_apD
6 a_apE
6 b_apF
6 $dMonad_apG
6 f_apH
6 x_apI
4 b_apJ
4 c_apK
4 a_apL
4 f_apM
4 g_apN
4 x_apO
2 a_apP
2 b_apQ
2 f_apR
2 x_apS
1 a_apX
1 g_apY
1 a_aql
1 b_aqm
1 k_aqn
1 z_aqo
2 a_aqS
2 b_aqT
2 m_aqU
2 k_aqV
2 ds_aqW
10 a_asv
10 b_asw
10 ds_asx
10 k_asy
3 s_asz
8 a_asH
8 x_asI
4 s_asJ
3 a_asQ
3 $dShow_asR
3 x_asS
3 eta_asT
2 a_aQf
2 b_aQg
2 f_aQh
2 x_aQi
2 s_aQj
1 ds_dpl
2 ds_dpq
1 a_dpw
1 c_dpx
1 n_dpy
13 SimplifierDone
13
------------------------------- Core -----------------------------------
IO.main8 :: Int
[GblId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=IF_ARGS [] 1 2}]
IO.main8 = I# 3
IO.main7
:: State# RealWorld
-> (# State# RealWorld, Int #)
[GblId,
Arity=1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=1, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=True)}]
IO.main7 =
\ (s_asJ :: State# RealWorld) ->
(# s_asJ, IO.main8 #)
IO.main6 :: [IO Int]
[GblId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=IF_ARGS [] 1 3}]
IO.main6 =
:
@ (IO Int)
(IO.main7
`cast` (sym (NTCo:IO Int)
:: (State# RealWorld
-> (# State# RealWorld, Int #))
~
IO Int))
([] @ (IO Int))
IO.main10 :: Int
[GblId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=IF_ARGS [] 1 2}]
IO.main10 = I# 2
IO.main9
:: State# RealWorld
-> (# State# RealWorld, Int #)
[GblId,
Arity=1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=1, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=True)}]
IO.main9 =
\ (s_asJ :: State# RealWorld) ->
(# s_asJ, IO.main10 #)
IO.main5 :: [IO Int]
[GblId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=IF_ARGS [] 1 3}]
IO.main5 =
:
@ (IO Int)
(IO.main9
`cast` (sym (NTCo:IO Int)
:: (State# RealWorld
-> (# State# RealWorld, Int #))
~
IO Int))
IO.main6
IO.main12 :: Int
[GblId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=IF_ARGS [] 1 2}]
IO.main12 = I# 1
IO.main11
:: State# RealWorld
-> (# State# RealWorld, Int #)
[GblId,
Arity=1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=1, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=True)}]
IO.main11 =
\ (s_asJ :: State# RealWorld) ->
(# s_asJ, IO.main12 #)
IO.main4 :: [IO Int]
[GblId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=IF_ARGS [] 1 3}]
IO.main4 =
:
@ (IO Int)
(IO.main11
`cast` (sym (NTCo:IO Int)
:: (State# RealWorld
-> (# State# RealWorld, Int #))
~
IO Int))
IO.main5
IO.main14 :: Int
[GblId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=IF_ARGS [] 1 2}]
IO.main14 = I# 0
IO.main13
:: State# RealWorld
-> (# State# RealWorld, Int #)
[GblId,
Arity=1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=1, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=True)}]
IO.main13 =
\ (s_asJ :: State# RealWorld) ->
(# s_asJ, IO.main14 #)
IO.main2 [Occ=LoopBreaker]
:: [IO Int]
-> State# RealWorld
-> (# State# RealWorld, Int #)
IO.main2 =
\ (ds_dpn :: [IO Int])
(eta_B1 :: State# RealWorld) ->
case ds_dpn of _ {
[] -> (# eta_B1, IO.main14 #);
: x_ad5 xs_ad6 ->
case (x_ad5
`cast` (NTCo:IO Int
:: IO Int
~
(State# RealWorld
-> (# State# RealWorld, Int #))))
eta_B1
of _ { (# new_s_asC, a1_asD #) ->
case IO.main2 xs_ad6 new_s_asC of _ { (# new_s1_aQm, a2_aQn #) ->
(# new_s1_aQm, plusInt a1_asD a2_aQn #)
}
}
}
IO.l :: [IO Int]
[GblId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=IF_ARGS [] 1 3}]
IO.l =
:
@ (IO Int)
(IO.main13
`cast` (sym (NTCo:IO Int)
:: (State# RealWorld
-> (# State# RealWorld, Int #))
~
IO Int))
IO.main4
IO.main15 [Occ=LoopBreaker]
:: [IO Int]
-> State# RealWorld
-> (# State# RealWorld, Int #)
IO.main15 =
\ (ds_dps :: [IO Int])
(eta_B1 :: State# RealWorld) ->
case ds_dps of _ {
[] -> (# eta_B1, IO.main14 #);
: x_acQ xs_acR ->
case (x_acQ
`cast` (NTCo:IO Int
:: IO Int
~
(State# RealWorld
-> (# State# RealWorld, Int #))))
eta_B1
of _ { (# new_s_asC, a1_asD #) ->
case IO.main15 xs_acR new_s_asC of _ { (# new_s1_XtA, a2_XtC #) ->
(# new_s1_XtA, plusInt a1_asD a2_XtC #)
}
}
}
IO.main3 [Occ=LoopBreaker]
:: [IO Int]
-> State# RealWorld
-> (# State# RealWorld, Int #)
IO.main3 =
\ (ds_dps :: [IO Int])
(eta_B1 :: State# RealWorld) ->
case ds_dps of _ {
[] -> (# eta_B1, IO.main14 #);
: x_acQ xs_acR ->
case (x_acQ
`cast` (NTCo:IO Int
:: IO Int
~
(State# RealWorld
-> (# State# RealWorld, Int #))))
eta_B1
of _ { (# new_s_Xta, a1_Xtc #) ->
case IO.main3 xs_acR new_s_Xta of _ { (# new_s1_aQm, a2_aQn #) ->
(# new_s1_aQm, plusInt a1_Xtc a2_aQn #)
}
}
}
IO.main1
:: State# RealWorld
-> (# State# RealWorld, () #)
[GblId,
Arity=1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=1, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=IF_ARGS [0] 35 0}]
IO.main1 =
\ (s_Xtp :: State# RealWorld) ->
case IO.main15 IO.l s_Xtp of _ { (# new_s_asC, a1_asD #) ->
case Handle.Text.hPutStr2
Handle.FD.stdout
($fShowInt_$cshow a1_asD)
True
new_s_asC
of _ { (# new_s1_XsX, _ #) ->
case IO.main3 IO.l new_s1_XsX of _ { (# new_s2_Xt4, a3_Xt6 #) ->
case Handle.Text.hPutStr2
Handle.FD.stdout
($fShowInt_$cshow a3_Xt6)
True
new_s2_Xt4
of _ { (# new_s3_Xty, _ #) ->
case IO.main2 IO.l new_s3_Xty of _ { (# new_s4_Xtc, a5_Xte #) ->
Handle.Text.hPutStr2
Handle.FD.stdout
($fShowInt_$cshow a5_Xte)
True
new_s4_Xtc
}
}
}
}
}
IO.main :: IO ()
[GblId,
Arity=1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=True)}]
IO.main =
IO.main1
`cast` (sym (NTCo:IO ())
:: (State# RealWorld
-> (# State# RealWorld, () #))
~
IO ())
------------------------------- Assembly -------------------------------
.data
.align 8
.globl IO_main8_closure
.type IO_main8_closure, @object
IO_main8_closure:
.quad ghczmprim_GHCziTypes_Izh_static_info
.quad 3
.data
.align 8
.globl IO_main7_closure
.type IO_main7_closure, @object
IO_main7_closure:
.quad IO_main7_info
.text
.align 8
.quad 4294967299
.quad 0
.quad 15
.globl IO_main7_info
.type IO_main7_info, @object
IO_main7_info:
.LcTo:
movl $IO_main8_closure+1,%ebx
jmp *0(%rbp)
.data
.align 8
.globl IO_main6_closure
.type IO_main6_closure, @object
IO_main6_closure:
.quad ghczmprim_GHCziTypes_ZC_static_info
.quad IO_main7_closure+1
.quad ghczmprim_GHCziTypes_ZMZN_closure+1
.quad 1
.data
.align 8
.globl IO_main10_closure
.type IO_main10_closure, @object
IO_main10_closure:
.quad ghczmprim_GHCziTypes_Izh_static_info
.quad 2
.data
.align 8
.globl IO_main9_closure
.type IO_main9_closure, @object
IO_main9_closure:
.quad IO_main9_info
.text
.align 8
.quad 4294967299
.quad 0
.quad 15
.globl IO_main9_info
.type IO_main9_info, @object
IO_main9_info:
.LcTJ:
movl $IO_main10_closure+1,%ebx
jmp *0(%rbp)
.data
.align 8
.globl IO_main5_closure
.type IO_main5_closure, @object
IO_main5_closure:
.quad ghczmprim_GHCziTypes_ZC_static_info
.quad IO_main9_closure+1
.quad IO_main6_closure+2
.quad 1
.data
.align 8
.globl IO_main12_closure
.type IO_main12_closure, @object
IO_main12_closure:
.quad ghczmprim_GHCziTypes_Izh_static_info
.quad 1
.data
.align 8
.globl IO_main11_closure
.type IO_main11_closure, @object
IO_main11_closure:
.quad IO_main11_info
.text
.align 8
.quad 4294967299
.quad 0
.quad 15
.globl IO_main11_info
.type IO_main11_info, @object
IO_main11_info:
.LcU4:
movl $IO_main12_closure+1,%ebx
jmp *0(%rbp)
.data
.align 8
.globl IO_main4_closure
.type IO_main4_closure, @object
IO_main4_closure:
.quad ghczmprim_GHCziTypes_ZC_static_info
.quad IO_main11_closure+1
.quad IO_main5_closure+2
.quad 1
.data
.align 8
.globl IO_main14_closure
.type IO_main14_closure, @object
IO_main14_closure:
.quad ghczmprim_GHCziTypes_Izh_static_info
.quad 0
.data
.align 8
.globl IO_main13_closure
.type IO_main13_closure, @object
IO_main13_closure:
.quad IO_main13_info
.text
.align 8
.quad 4294967299
.quad 0
.quad 15
.globl IO_main13_info
.type IO_main13_info, @object
IO_main13_info:
.LcUp:
movl $IO_main14_closure+1,%ebx
jmp *0(%rbp)
.data
.align 8
.globl IO_main2_closure
.type IO_main2_closure, @object
IO_main2_closure:
.quad IO_main2_info
.text
.align 8
.quad 2
.quad 19
sUw_info:
.LcUU:
leaq -16(%rbp),%rax
cmpq %r15,%rax
jb .LcUW
movq $stg_upd_frame_info,-16(%rbp)
movq %rbx,-8(%rbp)
movq 16(%rbx),%r14
movq 24(%rbx),%rsi
addq $-16,%rbp
jmp base_GHCziBase_plusInt_info
.LcUW:
jmp *-16(%r13)
.text
.align 8
.quad 1
.quad 32
sUu_info:
.LcV2:
addq $32,%r12
cmpq 144(%r13),%r12
ja .LcV6
movq $sUw_info,-24(%r12)
movq 8(%rbp),%rax
movq %rax,-8(%r12)
movq %rbx,0(%r12)
leaq -24(%r12),%rbx
addq $16,%rbp
jmp *0(%rbp)
.LcV6:
movq $32,184(%r13)
.LcV4:
movq $254,64(%r13)
jmp stg_gc_ut
.text
.align 8
.quad 1
.quad 32
sUv_info:
.LcVb:
movq 8(%rbp),%r14
movq %rbx,8(%rbp)
movq $sUu_info,0(%rbp)
jmp IO_main2_info
.text
.align 8
.quad 0
.quad 32
sUt_info:
.LcVl:
movq %rbx,%rax
andq $7,%rax
cmpq $2,%rax
jae .LcVm
movl $IO_main14_closure+1,%ebx
addq $8,%rbp
jmp *0(%rbp)
.LcVm:
movq 14(%rbx),%rax
movq %rax,0(%rbp)
movq 6(%rbx),%rbx
movq $sUv_info,-8(%rbp)
addq $-8,%rbp
jmp stg_ap_v_fast
.text
.align 8
.quad 8589934597
.quad 0
.quad 15
.globl IO_main2_info
.type IO_main2_info, @object
IO_main2_info:
.LcVt:
leaq -16(%rbp),%rax
cmpq %r15,%rax
jb .LcVv
movq %r14,%rbx
movq $sUt_info,-8(%rbp)
addq $-8,%rbp
testq $7,%rbx
jne sUt_info
jmp *(%rbx)
.LcVv:
movl $IO_main2_closure,%ebx
jmp *-8(%r13)
.data
.align 8
.globl IO_l_closure
.type IO_l_closure, @object
IO_l_closure:
.quad ghczmprim_GHCziTypes_ZC_static_info
.quad IO_main13_closure+1
.quad IO_main4_closure+2
.quad 1
.data
.align 8
.globl IO_main15_closure
.type IO_main15_closure, @object
IO_main15_closure:
.quad IO_main15_info
.text
.align 8
.quad 2
.quad 19
sVK_info:
.LcW9:
leaq -16(%rbp),%rax
cmpq %r15,%rax
jb .LcWb
movq $stg_upd_frame_info,-16(%rbp)
movq %rbx,-8(%rbp)
movq 16(%rbx),%r14
movq 24(%rbx),%rsi
addq $-16,%rbp
jmp base_GHCziBase_plusInt_info
.LcWb:
jmp *-16(%r13)
.text
.align 8
.quad 1
.quad 32
sVI_info:
.LcWh:
addq $32,%r12
cmpq 144(%r13),%r12
ja .LcWl
movq $sVK_info,-24(%r12)
movq 8(%rbp),%rax
movq %rax,-8(%r12)
movq %rbx,0(%r12)
leaq -24(%r12),%rbx
addq $16,%rbp
jmp *0(%rbp)
.LcWl:
movq $32,184(%r13)
.LcWj:
movq $254,64(%r13)
jmp stg_gc_ut
.text
.align 8
.quad 1
.quad 32
sVJ_info:
.LcWq:
movq 8(%rbp),%r14
movq %rbx,8(%rbp)
movq $sVI_info,0(%rbp)
jmp IO_main15_info
.text
.align 8
.quad 0
.quad 32
sVH_info:
.LcWA:
movq %rbx,%rax
andq $7,%rax
cmpq $2,%rax
jae .LcWB
movl $IO_main14_closure+1,%ebx
addq $8,%rbp
jmp *0(%rbp)
.LcWB:
movq 14(%rbx),%rax
movq %rax,0(%rbp)
movq 6(%rbx),%rbx
movq $sVJ_info,-8(%rbp)
addq $-8,%rbp
jmp stg_ap_v_fast
.text
.align 8
.quad 8589934597
.quad 0
.quad 15
.globl IO_main15_info
.type IO_main15_info, @object
IO_main15_info:
.LcWI:
leaq -16(%rbp),%rax
cmpq %r15,%rax
jb .LcWK
movq %r14,%rbx
movq $sVH_info,-8(%rbp)
addq $-8,%rbp
testq $7,%rbx
jne sVH_info
jmp *(%rbx)
.LcWK:
movl $IO_main15_closure,%ebx
jmp *-8(%r13)
.data
.align 8
.globl IO_main3_closure
.type IO_main3_closure, @object
IO_main3_closure:
.quad IO_main3_info
.text
.align 8
.quad 2
.quad 19
sWV_info:
.LcXj:
leaq -16(%rbp),%rax
cmpq %r15,%rax
jb .LcXl
movq $stg_upd_frame_info,-16(%rbp)
movq %rbx,-8(%rbp)
movq 16(%rbx),%r14
movq 24(%rbx),%rsi
addq $-16,%rbp
jmp base_GHCziBase_plusInt_info
.LcXl:
jmp *-16(%r13)
.text
.align 8
.quad 1
.quad 32
sWT_info:
.LcXr:
addq $32,%r12
cmpq 144(%r13),%r12
ja .LcXv
movq $sWV_info,-24(%r12)
movq 8(%rbp),%rax
movq %rax,-8(%r12)
movq %rbx,0(%r12)
leaq -24(%r12),%rbx
addq $16,%rbp
jmp *0(%rbp)
.LcXv:
movq $32,184(%r13)
.LcXt:
movq $254,64(%r13)
jmp stg_gc_ut
.text
.align 8
.quad 1
.quad 32
sWU_info:
.LcXA:
movq 8(%rbp),%r14
movq %rbx,8(%rbp)
movq $sWT_info,0(%rbp)
jmp IO_main3_info
.text
.align 8
.quad 0
.quad 32
sWS_info:
.LcXK:
movq %rbx,%rax
andq $7,%rax
cmpq $2,%rax
jae .LcXL
movl $IO_main14_closure+1,%ebx
addq $8,%rbp
jmp *0(%rbp)
.LcXL:
movq 14(%rbx),%rax
movq %rax,0(%rbp)
movq 6(%rbx),%rbx
movq $sWU_info,-8(%rbp)
addq $-8,%rbp
jmp stg_ap_v_fast
.text
.align 8
.quad 8589934597
.quad 0
.quad 15
.globl IO_main3_info
.type IO_main3_info, @object
IO_main3_info:
.LcXS:
leaq -16(%rbp),%rax
cmpq %r15,%rax
jb .LcXU
movq %r14,%rbx
movq $sWS_info,-8(%rbp)
addq $-8,%rbp
testq $7,%rbx
jne sWS_info
jmp *(%rbx)
.LcXU:
movl $IO_main3_closure,%ebx
jmp *-8(%r13)
.section .data
.align 8
.globl IO_main1_srt
.type IO_main1_srt, @object
IO_main1_srt:
.quad base_GHCziIOziHandleziFD_stdout_closure
.quad base_GHCziIOziHandleziText_hPutStr2_closure
.data
.align 8
.globl IO_main1_closure
.type IO_main1_closure, @object
IO_main1_closure:
.quad IO_main1_info
.quad 0
.text
.align 8
.quad 1
.quad 17
sY5_info:
.LcYt:
leaq -16(%rbp),%rax
cmpq %r15,%rax
jb .LcYv
movq $stg_upd_frame_info,-16(%rbp)
movq %rbx,-8(%rbp)
movq 16(%rbx),%r14
addq $-16,%rbp
jmp base_GHCziShow_zdfShowIntzuzdcshow_info
.LcYv:
jmp *-16(%r13)
.text
.align 8
.quad 1
.quad 17
sY9_info:
.LcYK:
leaq -16(%rbp),%rax
cmpq %r15,%rax
jb .LcYM
movq $stg_upd_frame_info,-16(%rbp)
movq %rbx,-8(%rbp)
movq 16(%rbx),%r14
addq $-16,%rbp
jmp base_GHCziShow_zdfShowIntzuzdcshow_info
.LcYM:
jmp *-16(%r13)
.text
.align 8
.quad 1
.quad 17
sYb_info:
.LcZ1:
leaq -16(%rbp),%rax
cmpq %r15,%rax
jb .LcZ3
movq $stg_upd_frame_info,-16(%rbp)
movq %rbx,-8(%rbp)
movq 16(%rbx),%r14
addq $-16,%rbp
jmp base_GHCziShow_zdfShowIntzuzdcshow_info
.LcZ3:
jmp *-16(%r13)
.text
.align 8
.long IO_main1_srt-(sY7_info)+0
.long 0
.quad 0
.quad 12884901920
sY7_info:
.LcZ8:
addq $24,%r12
cmpq 144(%r13),%r12
ja .LcZc
movq $sYb_info,-16(%r12)
movq %rbx,0(%r12)
movl $base_GHCziIOziHandleziFD_stdout_closure,%r14d
leaq -16(%r12),%rsi
movl $ghczmprim_GHCziBool_True_closure+2,%edi
addq $8,%rbp
jmp base_GHCziIOziHandleziText_hPutStr2_info
.LcZc:
movq $24,184(%r13)
.LcZa:
movq $254,64(%r13)
jmp stg_gc_ut
.text
.align 8
.long IO_main1_srt-(sY8_info)+0
.long 0
.quad 0
.quad 12884901920
sY8_info:
.LcZg:
movl $IO_l_closure+2,%r14d
movq $sY7_info,0(%rbp)
jmp IO_main2_info
.text
.align 8
.long IO_main1_srt-(sY3_info)+0
.long 0
.quad 0
.quad 12884901920
sY3_info:
.LcZk:
addq $24,%r12
cmpq 144(%r13),%r12
ja .LcZo
movq $sY9_info,-16(%r12)
movq %rbx,0(%r12)
movl $base_GHCziIOziHandleziFD_stdout_closure,%r14d
leaq -16(%r12),%rsi
movl $ghczmprim_GHCziBool_True_closure+2,%edi
movq $sY8_info,0(%rbp)
jmp base_GHCziIOziHandleziText_hPutStr2_info
.LcZo:
movq $24,184(%r13)
.LcZm:
movq $254,64(%r13)
jmp stg_gc_ut
.text
.align 8
.long IO_main1_srt-(sY4_info)+0
.long 0
.quad 0
.quad 12884901920
sY4_info:
.LcZs:
movl $IO_l_closure+2,%r14d
movq $sY3_info,0(%rbp)
jmp IO_main3_info
.text
.align 8
.long IO_main1_srt-(sY2_info)+0
.long 0
.quad 0
.quad 12884901920
sY2_info:
.LcZw:
addq $24,%r12
cmpq 144(%r13),%r12
ja .LcZA
movq $sY5_info,-16(%r12)
movq %rbx,0(%r12)
movl $base_GHCziIOziHandleziFD_stdout_closure,%r14d
leaq -16(%r12),%rsi
movl $ghczmprim_GHCziBool_True_closure+2,%edi
movq $sY4_info,0(%rbp)
jmp base_GHCziIOziHandleziText_hPutStr2_info
.LcZA:
movq $24,184(%r13)
.LcZy:
movq $254,64(%r13)
jmp stg_gc_ut
.text
.align 8
.long IO_main1_srt-(IO_main1_info)+0
.long 0
.quad 4294967299
.quad 0
.quad 12884901903
.globl IO_main1_info
.type IO_main1_info, @object
IO_main1_info:
.LcZF:
leaq -8(%rbp),%rax
cmpq %r15,%rax
jb .LcZH
movl $IO_l_closure+2,%r14d
movq $sY2_info,-8(%rbp)
addq $-8,%rbp
jmp IO_main15_info
.LcZH:
movl $IO_main1_closure,%ebx
jmp *-8(%r13)
.section .data
.align 8
.globl IO_main_srt
.type IO_main_srt, @object
IO_main_srt:
.quad IO_main1_closure
.data
.align 8
.globl IO_main_closure
.type IO_main_closure, @object
IO_main_closure:
.quad IO_main_info
.quad 0
.text
.align 8
.long IO_main_srt-(IO_main_info)+0
.long 0
.quad 4294967299
.quad 0
.quad 4294967311
.globl IO_main_info
.type IO_main_info, @object
IO_main_info:
.LcZV:
jmp IO_main1_info
.data
.align 8
_module_registered:
.quad 0
.text
.align 8
.globl __stginit_IO_
.type __stginit_IO_, @object
__stginit_IO_:
.Lc105:
cmpq $0,_module_registered
jne .Lc106
.Lc107:
movq $1,_module_registered
addq $-8,%rbp
movq $__stginit_base_ControlziMonad_,(%rbp)
addq $-8,%rbp
movq $__stginit_base_Prelude_,(%rbp)
.Lc106:
addq $8,%rbp
jmp *-8(%rbp)
.text
.align 8
.globl __stginit_IO
.type __stginit_IO, @object
__stginit_IO:
.Lc10b:
jmp __stginit_IO_
Raw
gistfile1.hs
import Control.Monad
l :: [IO Int]
l = [return 0, return 1, return 2, return 3]
foldrM' :: Monad m => (a -> m b -> m b) -> m b -> [m a] -> m b
foldrM' f z = act
where
act [] = z
act (x:xs) = ($ act xs) . f =<< x
-- Or: act (x:xs) = x >>= \x' -> f x' $ act xs
-- In theory, every monad is a functor, but the Haskell class hierarchy doesn't
-- reflect this (yet)...
foldrM'' :: (Functor m, Monad m) => (a -> b -> b) -> b -> [m a] -> m b
foldrM'' f z = act
where
act [] = return z
act (x:xs) = (`fmap` act xs) . f =<< x
-- Or: act (x:xs) = x >>= \x' -> act xs >>= \b' -> return $ f x' b'
main = do
print =<< foldrM' (\a b -> b >>= \b' -> return (a + b')) (return 0) l
print =<< foldrM' (fmap . (+)) (return 0) l
print =<< foldrM'' (+) 0 l
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment