Skip to content

Instantly share code, notes, and snippets.

@cartazio

cartazio/01-bugmain-simpl-NOINLINE.hs

Last active August 29, 2015 14:03
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 cartazio/351f15ae74257a7ab64d to your computer and use it in GitHub Desktop.
Save cartazio/351f15ae74257a7ab64d to your computer and use it in GitHub Desktop.
Download ZIP
Raw
01-bugmain-simpl-NOINLINE.hs
[1 of 1] Compiling Main ( bugMain.hs, bugMain.o )
==================== Tidy Core ====================
Result size of Tidy Core = {terms: 176, types: 151, coercions: 9}
compareDouble :: Double -> Double -> Ordering
compareDouble =
\ (x :: Double) (y :: Double) ->
case x of _ { D# ds1 ->
case {__pkg_ccall base isDoubleNaN Double#
-> State# RealWorld -> (# State# RealWorld, Int# #)}
ds1 realWorld#
of _ { (# ds2, ds3 #) ->
case ds3 of _ {
__DEFAULT ->
case y of _ { D# ds5 ->
case {__pkg_ccall base isDoubleNaN Double#
-> State# RealWorld -> (# State# RealWorld, Int# #)}
ds5 realWorld#
of _ { (# ds6, ds7 #) ->
case ds7 of _ {
__DEFAULT -> EQ;
0 -> LT
}
}
};
0 ->
case y of _ { D# ds5 ->
case {__pkg_ccall base isDoubleNaN Double#
-> State# RealWorld -> (# State# RealWorld, Int# #)}
ds5 realWorld#
of _ { (# ds6, ds7 #) ->
case ds7 of _ {
__DEFAULT -> GT;
0 ->
case ds1 of wild4 {
__DEFAULT ->
case tagToEnum# (<## wild4 ds5) of _ {
False ->
case tagToEnum# (==## wild4 ds5) of _ {
False -> GT;
True -> EQ
};
True -> LT
};
0.0 ->
case ds5 of wild5 {
__DEFAULT ->
case tagToEnum# (<## 0.0 wild5) of _ {
False -> GT;
True -> LT
};
0.0 ->
case {__pkg_ccall base isDoubleNegativeZero Double#
-> State# RealWorld -> (# State# RealWorld, Int# #)}
0.0 realWorld#
of _ { (# ds8, ds9 #) ->
case ds9 of _ {
__DEFAULT ->
case {__pkg_ccall base isDoubleNegativeZero Double#
-> State# RealWorld -> (# State# RealWorld, Int# #)}
0.0 realWorld#
of _ { (# ds10, ds11 #) ->
case ds11 of _ {
__DEFAULT -> EQ;
0 -> LT
}
};
0 ->
case {__pkg_ccall base isDoubleNegativeZero Double#
-> State# RealWorld -> (# State# RealWorld, Int# #)}
0.0 realWorld#
of _ { (# ds10, ds11 #) ->
case ds11 of _ {
__DEFAULT -> GT;
0 -> EQ
}
}
}
}
}
}
}
}
}
}
}
}
main6 :: Double
main6 = D# (negateDouble# 0.0)
main5 :: Double
main5 = D# 0.0
main4 :: [Double]
main4 = : main5 ([])
main_l :: [Double]
main_l = : main6 main4
Rec {
main_go :: [Double] -> [(Double, Double, Ordering)]
main_go =
\ (ds :: [Double]) ->
case ds of _ {
[] -> [];
: y ys ->
let {
z :: [(Double, Double, Ordering)]
z = main_go ys } in
letrec {
go :: [Double] -> [(Double, Double, Ordering)]
go =
\ (ds1 :: [Double]) ->
case ds1 of _ {
[] -> z;
: y1 ys1 -> : (y, y1, compareDouble y y1) (go ys1)
}; } in
go main_l
}
end Rec }
main3 :: [(Double, Double, Ordering)]
main3 = main_go main_l
main2 :: String
main2 =
$fShow(,,)_$cshowList
$fShowDouble $fShowDouble $fShowOrdering main3 ([])
main1 :: State# RealWorld -> (# State# RealWorld, () #)
main1 =
\ (eta :: State# RealWorld) -> hPutStr2 stdout main2 True eta
main :: IO ()
main = main1 `cast` ...
main7 :: State# RealWorld -> (# State# RealWorld, () #)
main7 =
\ (eta :: State# RealWorld) -> runMainIO1 (main1 `cast` ...) eta
main :: IO ()
main = main7 `cast` ...
Linking bugMain ...
Raw
01main-simpl.hs
[1 of 1] Compiling Main ( bugMain.hs, bugMain.o )
==================== Tidy Core ====================
Result size of Tidy Core = {terms: 190, types: 154, coercions: 9}
main6 :: Double
main6 = D# (negateDouble# 0.0)
main5 :: Double
main5 = D# 0.0
main4 :: [Double]
main4 = : main5 ([])
main_l :: [Double]
main_l = : main6 main4
Rec {
main_go :: [Double] -> [(Double, Double, Ordering)]
main_go =
\ (ds :: [Double]) ->
case ds of _ {
[] -> [];
: y ys ->
let {
z :: [(Double, Double, Ordering)]
z = main_go ys } in
let {
lvl :: Bool
lvl =
case y of _ { D# ds2 ->
case {__pkg_ccall base isDoubleNegativeZero Double#
-> State# RealWorld -> (# State# RealWorld, Int# #)}
ds2 realWorld#
of _ { (# ds3, ds4 #) ->
case ds4 of _ {
__DEFAULT -> True;
0 -> False
}
}
} } in
let {
lvl1 :: Bool
lvl1 =
case y of _ { D# ds2 ->
case {__pkg_ccall base isDoubleNaN Double#
-> State# RealWorld -> (# State# RealWorld, Int# #)}
ds2 realWorld#
of _ { (# ds3, ds4 #) ->
case ds4 of _ {
__DEFAULT -> True;
0 -> False
}
}
} } in
letrec {
go :: [Double] -> [(Double, Double, Ordering)]
go =
\ (ds1 :: [Double]) ->
case ds1 of _ {
[] -> z;
: y1 ys1 ->
: (y,
y1,
case lvl1 of _ {
False ->
case y1 of _ { D# ds3 ->
case {__pkg_ccall base isDoubleNaN Double#
-> State# RealWorld -> (# State# RealWorld, Int# #)}
ds3 realWorld#
of _ { (# ds4, ds5 #) ->
case ds5 of _ {
__DEFAULT -> GT;
0 ->
case y of _ { D# x ->
case x of wild6 {
__DEFAULT ->
case tagToEnum# (<## wild6 ds3) of _ {
False ->
case tagToEnum# (==## wild6 ds3) of _ {
False -> GT;
True -> EQ
};
True -> LT
};
0.0 ->
case ds3 of wild7 {
__DEFAULT ->
case tagToEnum# (<## 0.0 wild7) of _ {
False -> GT;
True -> LT
};
0.0 ->
case lvl of _ {
False ->
case {__pkg_ccall base isDoubleNegativeZero Double#
-> State# RealWorld -> (# State# RealWorld, Int# #)}
0.0 realWorld#
of _ { (# ds6, ds7 #) ->
case ds7 of _ {
__DEFAULT -> GT;
0 -> EQ
}
};
True ->
case {__pkg_ccall base isDoubleNegativeZero Double#
-> State# RealWorld -> (# State# RealWorld, Int# #)}
0.0 realWorld#
of _ { (# ds6, ds7 #) ->
case ds7 of _ {
__DEFAULT -> EQ;
0 -> LT
}
}
}
}
}
}
}
}
};
True ->
case y1 of _ { D# ds3 ->
case {__pkg_ccall base isDoubleNaN Double#
-> State# RealWorld -> (# State# RealWorld, Int# #)}
ds3 realWorld#
of _ { (# ds4, ds5 #) ->
case ds5 of _ {
__DEFAULT -> EQ;
0 -> LT
}
}
}
})
(go ys1)
}; } in
go main_l
}
end Rec }
main3 :: [(Double, Double, Ordering)]
main3 = main_go main_l
main2 :: String
main2 =
$fShow(,,)_$cshowList
$fShowDouble $fShowDouble $fShowOrdering main3 ([])
main1 :: State# RealWorld -> (# State# RealWorld, () #)
main1 =
\ (eta :: State# RealWorld) -> hPutStr2 stdout main2 True eta
main :: IO ()
main = main1 `cast` ...
main7 :: State# RealWorld -> (# State# RealWorld, () #)
main7 =
\ (eta :: State# RealWorld) -> runMainIO1 (main1 `cast` ...) eta
main :: IO ()
main = main7 `cast` ...
Linking bugMain ...
Raw
O0main-simple.hs
[1 of 1] Compiling Main ( bugMain.hs, bugMain.o )
==================== Tidy Core ====================
Result size of Tidy Core = {terms: 124, types: 86, coercions: 0}
a :: Double
a = negate $fNumDouble (D# 0.0)
a1 :: Double
a1 = D# 0.0
a2 :: [Double]
a2 = : a1 ([])
l :: [Double]
l = : a a2
main :: IO ()
main =
print
($fShow[] ($fShow(,,) $fShowDouble $fShowDouble $fShowOrdering))
(letrec {
ds :: [Double] -> [(Double, Double, Ordering)]
ds =
\ (ds1 :: [Double]) ->
case ds1 of _ {
[] -> [];
: ds3 ds4 ->
letrec {
ds5 :: [Double] -> [(Double, Double, Ordering)]
ds5 =
\ (ds6 :: [Double]) ->
case ds6 of _ {
[] -> ds ds4;
: ds8 ds9 ->
: (ds3,
ds8,
case isNaN $fRealFloatDouble ds3 of _ {
False ->
case isNaN $fRealFloatDouble ds8 of _ {
False ->
case == $fEqDouble ds3 (D# 0.0) of _ {
False -> compare $fOrdDouble ds3 ds8;
True ->
case == $fEqDouble ds8 (D# 0.0) of _ {
False -> compare $fOrdDouble ds3 ds8;
True ->
case isNegativeZero $fRealFloatDouble ds3 of _ {
False ->
case isNegativeZero $fRealFloatDouble ds8 of _ {
False -> compare $fOrdDouble ds3 ds8;
True -> GT
};
True ->
case isNegativeZero $fRealFloatDouble ds8 of _ {
False -> LT;
True -> compare $fOrdDouble ds3 ds8
}
}
}
};
True -> GT
};
True ->
case isNaN $fRealFloatDouble ds8 of _ {
False -> LT;
True -> EQ
}
})
(ds5 ds9)
}; } in
ds5 l
}; } in
ds l)
main :: IO ()
main = runMainIO main
Linking bugMain ...
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment