Skip to content

Instantly share code, notes, and snippets.

@mbrc12

mbrc12/factorcore.hs

Created July 21, 2018 12:45
Show Gist options
  • Save mbrc12/d96e6b774fb6c127876c0c865bed3164 to your computer and use it in GitHub Desktop.
Save mbrc12/d96e6b774fb6c127876c0c865bed3164 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
factorcore.hs
==================== Tidy Core ====================
Result size of Tidy Core
= {terms: 548, types: 702, coercions: 164, joins: 4/13}
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
maxn :: Int
maxn = I# 1000000#
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
$trModule4 :: Addr#
$trModule4 = "main"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
$trModule3 :: TrName
$trModule3 = TrNameS $trModule4
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
$trModule2 :: Addr#
$trModule2 = "Main"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
$trModule1 :: TrName
$trModule1 = TrNameS $trModule2
-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
$trModule :: Module
$trModule = Module $trModule3 $trModule1
-- RHS size: {terms: 8, types: 12, coercions: 0, joins: 0/0}
main_showl :: [Int] -> String
main_showl
= \ (w :: [Int]) ->
case $wshowl w of { (# ww1, ww2 #) -> : @ Char ww1 ww2 }
-- RHS size: {terms: 23, types: 30, coercions: 0, joins: 0/0}
$wshowl :: [Int] -> (# Char, [Char] #)
$wshowl
= \ (w :: [Int]) ->
case w of {
[] -> (# showList__2, [] @ Char #);
: y ys ->
(# showList__1,
case y of { I# ww1 ->
case $wshowSignedInt 0# ww1 (main_showl ys) of { (# ww3, ww4 #) ->
: @ Char ww3 ww4
}
} #)
}
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
lvl1 :: Addr#
lvl1 = "Int"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
lvl2 :: [Char]
lvl2 = unpackCString# lvl1
-- RHS size: {terms: 4, types: 9, coercions: 0, joins: 0/0}
lvl3 :: Array Int [I] -> ((), Array Int [I])
lvl3 = \ (eta1 :: Array Int [I]) -> ((), eta1)
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
main_l :: Int
main_l = I# 2#
-- RHS size: {terms: 9, types: 5, coercions: 0, joins: 0/0}
lvl4 :: Int -> Int -> Int -> Int
lvl4
= \ (u :: Int) (l :: Int) (x :: Int) ->
$windexError @ Int @ Int $fShowInt l u x lvl2
-- RHS size: {terms: 305, types: 347, coercions: 155, joins: 2/11}
$wgo :: Int# -> Array Int [I] -> (# (), Array Int [I] #)
$wgo
= \ (w :: Int#) (w1 :: Array Int [I]) ->
let {
x2 :: Int#
x2 = +# w w } in
let {
wild :: Int
wild = I# w } in
let {
$sc
:: Array Int [Int]
-> StateT (Array Int [Int]) Identity ()
-> Int#
-> Identity ((), Array Int [I])
$sc
= \ (sc :: Array Int [Int])
(sc1 :: StateT (Array Int [Int]) Identity ())
(sc2 :: Int#) ->
(sc1 `cast` <Co:7>)
(case sc of { Array l u dt ds ->
case l of wild2 { I# m ->
case u of wild3 { I# n ->
case runRW#
@ ('TupleRep '['TupleRep '[], 'LiftedRep])
@ (# State# RealWorld, Array Int [Int] #)
(\ (s1 :: State# RealWorld) ->
case newArray# @ [Int] @ RealWorld dt (arrEleBottom @ [Int]) s1 of
{ (# ipv, ipv1 #) ->
join {
$j :: State# RealWorld -> (# State# RealWorld, Array Int [Int] #)
$j (s3#
:: State# RealWorld
Unf=OtherCon [])
= case <=# m sc2 of {
__DEFAULT -> case lvl4 wild3 wild2 (I# sc2) of wild4 { };
1# ->
case <=# sc2 n of {
__DEFAULT -> case lvl4 wild3 wild2 (I# sc2) of wild4 { };
1# ->
case writeArray#
@ RealWorld
@ [Int]
ipv1
(-# sc2 m)
(: @ Int
wild
(case indexArray# @ [Int] ds (-# sc2 m) of
{ (# ipv2 #) ->
ipv2
}))
s3#
of s2#
{ __DEFAULT ->
case unsafeFreezeArray# @ RealWorld @ [Int] ipv1 s2# of
{ (# ipv2, ipv3 #) ->
(# ipv2, Array @ Int @ [Int] wild2 wild3 dt ipv3 #)
}
}
}
} } in
joinrec {
copy
:: Int#
-> State# RealWorld -> (# State# RealWorld, Array Int [Int] #)
copy (i# :: Int#) (s3# :: State# RealWorld)
= case ==# i# dt of {
__DEFAULT ->
case indexArray# @ [Int] ds i# of { (# ipv2 #) ->
case writeArray# @ RealWorld @ [Int] ipv1 i# ipv2 s3# of s4#
{ __DEFAULT ->
jump copy (+# i# 1#) s4#
}
};
1# -> jump $j s3#
}; } in
jump copy 0# ipv
})
of
{ (# ipv, ipv1 #) ->
ipv1
}
}
}
}) } in
case >=# x2 w of {
__DEFAULT ->
case ># 1000000# x2 of {
__DEFAULT ->
let {
delta :: Int#
delta = -# x2 w } in
let {
y' :: Int#
y' = -# 1000000# delta } in
letrec {
go_dn :: Int# -> Array Int [I] -> Identity ((), Array Int [I])
go_dn
= \ (x :: Int#) (eta :: Array Int [I]) ->
case <# x y' of {
__DEFAULT -> $sc eta ((go_dn (+# x delta)) `cast` <Co:8>) x;
1# -> $sc eta (lvl3 `cast` <Co:22>) x
}; } in
case ($sc w1 ((go_dn x2) `cast` <Co:8>) w) `cast` <Co:7> of
{ (a1, s') ->
case w of wild2 {
__DEFAULT -> $wgo (+# wild2 1#) s';
1000000# -> (# (), s' #)
}
};
1# ->
case ># 1000000# w of {
__DEFAULT ->
case ($sc w1 (lvl3 `cast` <Co:22>) w) `cast` <Co:7> of
{ (a1, s') ->
case w of wild2 {
__DEFAULT -> $wgo (+# wild2 1#) s';
1000000# -> (# (), s' #)
}
};
1# ->
case w of wild1 {
__DEFAULT -> $wgo (+# wild1 1#) w1;
1000000# -> (# (), w1 #)
}
}
};
1# ->
case <# 1000000# x2 of {
__DEFAULT ->
let {
delta :: Int#
delta = -# x2 w } in
let {
y' :: Int#
y' = -# 1000000# delta } in
letrec {
go_up :: Int# -> Array Int [I] -> Identity ((), Array Int [I])
go_up
= \ (x :: Int#) (eta :: Array Int [I]) ->
case ># x y' of {
__DEFAULT -> $sc eta ((go_up (+# x delta)) `cast` <Co:8>) x;
1# -> $sc eta (lvl3 `cast` <Co:22>) x
}; } in
case ($sc w1 ((go_up x2) `cast` <Co:8>) w) `cast` <Co:7> of
{ (a1, s') ->
case w of wild2 {
__DEFAULT -> $wgo (+# wild2 1#) s';
1000000# -> (# (), s' #)
}
};
1# ->
case <# 1000000# w of {
__DEFAULT ->
case ($sc w1 (lvl3 `cast` <Co:22>) w) `cast` <Co:7> of
{ (a1, s') ->
case w of wild2 {
__DEFAULT -> $wgo (+# wild2 1#) s';
1000000# -> (# (), s' #)
}
};
1# ->
case w of wild1 {
__DEFAULT -> $wgo (+# wild1 1#) w1;
1000000# -> (# (), w1 #)
}
}
}
}
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
lvl5 :: Int
lvl5 = I# 1000#
-- RHS size: {terms: 8, types: 4, coercions: 0, joins: 0/0}
main3 :: I -> I -> Int
main3
= \ (u :: I) (l :: I) ->
$windexError @ Int @ Int $fShowInt l u lvl5 lvl2
-- RHS size: {terms: 8, types: 3, coercions: 0, joins: 0/0}
main6 :: Int# -> Int
main6
= \ (x :: Int#) ->
$windexError @ Int @ Int $fShowInt main_l maxn (I# x) lvl2
-- RHS size: {terms: 65, types: 98, coercions: 0, joins: 2/2}
main5 :: State# RealWorld -> (# State# RealWorld, Array Int [I] #)
main5
= \ (s1# :: State# RealWorld) ->
case newArray# @ [I] @ RealWorld 999999# (arrEleBottom @ [I]) s1#
of
{ (# ipv, ipv1 #) ->
join {
exit :: State# RealWorld -> (# State# RealWorld, Array Int [I] #)
exit (s2# :: State# RealWorld)
= case unsafeFreezeArray# @ RealWorld @ [I] ipv1 s2# of
{ (# ipv2, ipv3 #) ->
(# ipv2, Array @ Int @ [I] main_l maxn 999999# ipv3 #)
} } in
joinrec {
go
:: Int#
-> State# RealWorld -> (# State# RealWorld, Array Int [I] #)
go (x :: Int#) (eta :: State# RealWorld)
= case <=# 2# x of {
__DEFAULT -> case main6 x of wild { };
1# ->
case <=# x 1000000# of {
__DEFAULT -> case main6 x of wild { };
1# ->
case writeArray# @ RealWorld @ [I] ipv1 (-# x 2#) ([] @ I) eta
of s2#
{ __DEFAULT ->
case x of wild {
__DEFAULT -> jump go (+# wild 1#) s2#;
1000000# -> jump exit s2#
}
}
}
}; } in
jump go 2# ipv
}
-- RHS size: {terms: 5, types: 39, coercions: 0, joins: 0/0}
main4 :: Array Int [I]
main4
= case runRW#
@ ('TupleRep '['TupleRep '[], 'LiftedRep])
@ (# State# RealWorld, Array Int [I] #)
main5
of
{ (# ipv, ipv1 #) ->
ipv1
}
-- RHS size: {terms: 63, types: 58, coercions: 0, joins: 0/0}
main2 :: String
main2
= case $wgo 2# main4 of { (# ww1, ww2 #) ->
case ww2 of { Array l u dt ds ->
case l of wild1 { I# m ->
case u of wild2 { I# n ->
case <=# m 1000# of {
__DEFAULT -> case main3 wild2 wild1 of wild4 { };
1# ->
case <=# 1000# n of {
__DEFAULT -> case main3 wild2 wild1 of wild4 { };
1# ->
case indexArray# @ [I] ds (-# 1000# m) of { (# ipv #) ->
case ipv of {
[] -> unpackAppendCString# showList__4 ([] @ Char);
: x xs ->
: @ Char
showList__3
(case x of { I# ww4 ->
case $wshowSignedInt 0# ww4 (main_showl xs) of { (# ww6, ww7 #) ->
: @ Char ww6 ww7
}
})
}
}
}
}
}
}
}
}
-- RHS size: {terms: 4, types: 0, coercions: 0, joins: 0/0}
main1 :: State# RealWorld -> (# State# RealWorld, () #)
main1 = hPutStr2 stdout main2 True
-- RHS size: {terms: 1, types: 0, coercions: 3, joins: 0/0}
main :: IO ()
main = main1 `cast` <Co:3>
-- RHS size: {terms: 2, types: 1, coercions: 3, joins: 0/0}
main7 :: State# RealWorld -> (# State# RealWorld, () #)
main7 = runMainIO1 @ () (main1 `cast` <Co:3>)
-- RHS size: {terms: 1, types: 0, coercions: 3, joins: 0/0}
main :: IO ()
main = main7 `cast` <Co:3>
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment