Skip to content

Instantly share code, notes, and snippets.

@andrewthad

andrewthad/witherable_fusion_example.dump-simpl

Created December 12, 2019 13:36
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save andrewthad/c1bca65dbf002921c328beaca96e6489 to your computer and use it in GitHub Desktop.
Save andrewthad/c1bca65dbf002921c328beaca96e6489 to your computer and use it in GitHub Desktop.
Download ZIP
Witherable List Fusion Consumer
Raw
witherable_fusion_example.dump-simpl
==================== Tidy Core ====================
Result size of Tidy Core
= {terms: 444, types: 513, coercions: 11, joins: 0/4}
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
$trModule4 = "main"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
$trModule3 = TrNameS $trModule4
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
$trModule2 = "Example"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
$trModule1 = TrNameS $trModule2
-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
$trModule = Module $trModule3 $trModule1
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
$tcA2 = "A"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
$tcA1 = TrNameS $tcA2
-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
$tcA
= TyCon
2446416244453844708##
14654573387719131265##
$trModule
$tcA1
0#
krep$*
-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
$tc'A4 = KindRepTyConApp $tcA []
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
$tc'A6 = "'A0"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
$tc'A5 = TrNameS $tc'A6
-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
$tc'A0
= TyCon
9619071568112689067##
8494207931088757535##
$trModule
$tc'A5
0#
$tc'A4
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
$tc'A8 = "'A1"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
$tc'A7 = TrNameS $tc'A8
-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
$tc'A1
= TyCon
8158414636519176608##
15262703443753651507##
$trModule
$tc'A7
0#
$tc'A4
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
$tc'A10 = "'A2"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
$tc'A9 = TrNameS $tc'A10
-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
$tc'A2
= TyCon
823121301974079838##
5110333606250247579##
$trModule
$tc'A9
0#
$tc'A4
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
$tc'A12 = "'A3"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
$tc'A11 = TrNameS $tc'A12
-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
$tc'A3
= TyCon
14798492395276878994##
10943727286575334283##
$trModule
$tc'A11
0#
$tc'A4
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
$tcB2 = "B"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
$tcB1 = TrNameS $tcB2
-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
$tcB
= TyCon
6938308639420137507##
7281555851335883274##
$trModule
$tcB1
0#
krep$*
-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
$tc'B7 = KindRepTyConApp $tcB []
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
$tc'B9 = "'B0"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
$tc'B8 = TrNameS $tc'B9
-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
$tc'B0
= TyCon
16059957321411333797##
2998291241548084709##
$trModule
$tc'B8
0#
$tc'B7
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
$tc'B11 = "'B1"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
$tc'B10 = TrNameS $tc'B11
-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
$tc'B1
= TyCon
5287026847245819508##
13914838412576495597##
$trModule
$tc'B10
0#
$tc'B7
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
$tc'B13 = "'B2"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
$tc'B12 = TrNameS $tc'B13
-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
$tc'B2
= TyCon
3880645084122605692##
7656610039999952330##
$trModule
$tc'B12
0#
$tc'B7
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
$tc'B15 = "'B3"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
$tc'B14 = TrNameS $tc'B15
-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
$tc'B3
= TyCon
7472265004078865237##
16735793166232388266##
$trModule
$tc'B14
0#
$tc'B7
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
$tc'B17 = "'B4"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
$tc'B16 = TrNameS $tc'B17
-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
$tc'B4
= TyCon
6507876063656351041##
11334924763151957994##
$trModule
$tc'B16
0#
$tc'B7
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
$tcC2 = "C"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
$tcC1 = TrNameS $tcC2
-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
$tcC
= TyCon
5381050974456779672##
3879843066031074398##
$trModule
$tcC1
0#
krep$*
-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
$tc'C2 = KindRepTyConApp $tcC []
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
$tc'C4 = "'C0"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
$tc'C3 = TrNameS $tc'C4
-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
$tc'C0
= TyCon
9724299857350984529##
1386482099044053076##
$trModule
$tc'C3
0#
$tc'C2
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
$tc'C6 = "'C1"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
$tc'C5 = TrNameS $tc'C6
-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
$tc'C1
= TyCon
14125198008739404185##
3499476733151043470##
$trModule
$tc'C5
0#
$tc'C2
-- RHS size: {terms: 222, types: 414, coercions: 0, joins: 0/4}
$wshouldFuse
= \ ww_s5if w_s5ib w1_s5ic ->
letrec {
$sgo_s5jV
= \ sc_s5jQ ->
case readMutVar# ww_s5if sc_s5jQ of { (# ipv_a5dK, ipv1_a5dL #) ->
case ipv1_a5dL of { __DEFAULT -> $sgo2_s5jW ipv_a5dK }
};
$sgo1_s5jU
= \ sc_s5jO ->
case readMutVar# ww_s5if sc_s5jO of { (# ipv_a5dK, ipv1_a5dL #) ->
case ipv1_a5dL of {
C0 ->
case readMutVar# ww_s5if ipv_a5dK of
{ (# ipv2_X5fL, ipv3_X5fN #) ->
case ipv3_X5fN of { __DEFAULT ->
case $sgo2_s5jW ipv2_X5fL of { (# ipv4_a5fr, ipv5_a5fs #) ->
(# ipv4_a5fr, : C1 ipv5_a5fs #)
}
}
};
C1 -> $sgo_s5jV ipv_a5dK
}
};
$sgo2_s5jW
= \ sc_s5jS ->
case readMutVar# ww_s5if sc_s5jS of { (# ipv_a5dK, ipv1_a5dL #) ->
case ipv1_a5dL of { __DEFAULT -> go_s5gr B4 ipv_a5dK }
};
go_s5gr
= \ b2_a542 eta_X1S ->
case b2_a542 of {
B0 ->
case readMutVar# ww_s5if eta_X1S of { (# ipv_a5dK, ipv1_a5dL #) ->
case ipv1_a5dL of {
C0 ->
case readMutVar# ww_s5if ipv_a5dK of
{ (# ipv2_X5fS, ipv3_X5fU #) ->
case ipv3_X5fU of {
C0 ->
case readMutVar# ww_s5if ipv2_X5fS of
{ (# ipv4_X5fL, ipv5_X5fN #) ->
case ipv5_X5fN of { __DEFAULT ->
case $sgo2_s5jW ipv4_X5fL of { (# ipv6_a5fr, ipv7_a5fs #) ->
(# ipv6_a5fr, : C0 (: C1 ipv7_a5fs) #)
}
}
};
C1 ->
case readMutVar# ww_s5if ipv2_X5fS of
{ (# ipv4_X5g1, ipv5_X5g3 #) ->
case ipv5_X5g3 of { __DEFAULT ->
case $sgo2_s5jW ipv4_X5g1 of { (# ipv6_a5fr, ipv7_a5fs #) ->
(# ipv6_a5fr, : C0 ipv7_a5fs #)
}
}
}
}
};
C1 ->
case readMutVar# ww_s5if ipv_a5dK of
{ (# ipv2_X5fS, ipv3_X5fU #) ->
case ipv3_X5fU of {
C0 ->
case readMutVar# ww_s5if ipv2_X5fS of
{ (# ipv4_X5fL, ipv5_X5fN #) ->
case ipv5_X5fN of { __DEFAULT ->
case $sgo2_s5jW ipv4_X5fL of { (# ipv6_a5fr, ipv7_a5fs #) ->
(# ipv6_a5fr, : C1 (: C1 ipv7_a5fs) #)
}
}
};
C1 ->
case readMutVar# ww_s5if ipv2_X5fS of
{ (# ipv4_X5g1, ipv5_X5g3 #) ->
case ipv5_X5g3 of { __DEFAULT ->
case $sgo2_s5jW ipv4_X5g1 of { (# ipv6_a5fr, ipv7_a5fs #) ->
(# ipv6_a5fr, : C1 ipv7_a5fs #)
}
}
}
}
}
}
};
B1 ->
case readMutVar# ww_s5if eta_X1S of { (# ipv_a5dK, ipv1_a5dL #) ->
case ipv1_a5dL of {
C0 ->
case readMutVar# ww_s5if ipv_a5dK of
{ (# ipv2_X5fS, ipv3_X5fU #) ->
case ipv3_X5fU of { __DEFAULT ->
case $sgo2_s5jW ipv2_X5fS of { (# ipv4_a5fr, ipv5_a5fs #) ->
(# ipv4_a5fr, : C1 ipv5_a5fs #)
}
}
};
C1 -> $sgo_s5jV ipv_a5dK
}
};
B2 ->
case readMutVar# ww_s5if eta_X1S of { (# ipv_a5dK, ipv1_a5dL #) ->
case ipv1_a5dL of { __DEFAULT -> $sgo2_s5jW ipv_a5dK }
};
B3 ->
case readMutVar# ww_s5if eta_X1S of { (# ipv_a5dK, ipv1_a5dL #) ->
case ipv1_a5dL of { __DEFAULT -> go_s5gr B4 ipv_a5dK }
};
B4 -> (# eta_X1S, [] #)
}; } in
go_s5gr w_s5ib w1_s5ic
-- RHS size: {terms: 10, types: 11, coercions: 2, joins: 0/0}
shouldFuse1
= \ w_s5ia w1_s5ib w2_s5ic ->
case w_s5ia `cast` <Co:2> of { STRef ww1_s5if ->
$wshouldFuse ww1_s5if w1_s5ib w2_s5ic
}
-- RHS size: {terms: 1, types: 0, coercions: 9, joins: 0/0}
shouldFuse = shouldFuse1 `cast` <Co:9>
Raw
witherable_fusion_example.hs
{-# language BangPatterns #-}
{-# OPTIONS_GHC -O2 -ddump-simpl -ddump-to-file -dsuppress-all -Wall -fforce-recomp #-}
module Example
( shouldFuse
) where
import Data.List (unfoldr)
import Data.IORef (IORef,readIORef)
import Data.Witherable (witherM,wither)
data A = A0 | A1 | A2 | A3
data B = B0 | B1 | B2 | B3 | B4
data C = C0 | C1
shouldFuse :: IORef C -> B -> IO [C]
shouldFuse !ref b0 = witherM (downcast ref) (unfoldr stepB b0)
downcast :: IORef C -> A -> IO (Maybe C)
downcast !ref a = do
c <- readIORef ref
pure (stepA c a)
stepA :: C -> A -> Maybe C
stepA C0 A0 = Just C0
stepA C1 A0 = Just C1
stepA C0 A1 = Just C1
stepA C1 A1 = Nothing
stepA _ A2 = Nothing
stepA _ A3 = Nothing
stepB :: B -> Maybe (A,B)
stepB B0 = Just (A0,B1)
stepB B1 = Just (A1,B2)
stepB B2 = Just (A2,B3)
stepB B3 = Just (A3,B4)
stepB B4 = Nothing
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment