Commit 89458eba authored by thomie's avatar thomie Committed by Austin Seipp

Pretty-print # on unboxed literals in core

Summary:
Ticket #10104 dealt with showing the '#'s on types with unboxed fields. This
commit pretty prints the '#'s on unboxed literals in core output.

Test Plan: simplCore/should_compile/T8274

Reviewers: jstolarek, simonpj, austin

Reviewed By: simonpj, austin

Subscribers: simonpj, thomie

Differential Revision: https://phabricator.haskell.org/D678

GHC Trac Issues: #8274
parent 5200bdeb
......@@ -440,33 +440,66 @@ litTag (LitInteger {}) = _ILIT(11)
{-
Printing
~~~~~~~~
* MachX (i.e. unboxed) things are printed unadornded (e.g. 3, 'a', "foo")
exceptions: MachFloat gets an initial keyword prefix.
* See Note [Printing of literals in Core]
-}
pprLiteral :: (SDoc -> SDoc) -> Literal -> SDoc
-- The function is used on non-atomic literals
-- to wrap parens around literals that occur in
-- a context requiring an atomic thing
pprLiteral _ (MachChar ch) = pprHsChar ch
pprLiteral _ (MachChar c) = pprPrimChar c
pprLiteral _ (MachStr s) = pprHsBytes s
pprLiteral _ (MachInt i) = pprIntVal i
pprLiteral _ (MachDouble d) = double (fromRat d)
pprLiteral _ (MachNullAddr) = ptext (sLit "__NULL")
pprLiteral add_par (LitInteger i _) = add_par (ptext (sLit "__integer") <+> integer i)
pprLiteral add_par (MachInt64 i) = add_par (ptext (sLit "__int64") <+> integer i)
pprLiteral add_par (MachWord w) = add_par (ptext (sLit "__word") <+> integer w)
pprLiteral add_par (MachWord64 w) = add_par (ptext (sLit "__word64") <+> integer w)
pprLiteral add_par (MachFloat f) = add_par (ptext (sLit "__float") <+> float (fromRat f))
pprLiteral _ (MachInt i) = pprPrimInt i
pprLiteral _ (MachInt64 i) = pprPrimInt64 i
pprLiteral _ (MachWord w) = pprPrimWord w
pprLiteral _ (MachWord64 w) = pprPrimWord64 w
pprLiteral _ (MachFloat f) = float (fromRat f) <> primFloatSuffix
pprLiteral _ (MachDouble d) = double (fromRat d) <> primDoubleSuffix
pprLiteral add_par (LitInteger i _) = pprIntegerVal add_par i
pprLiteral add_par (MachLabel l mb fod) = add_par (ptext (sLit "__label") <+> b <+> ppr fod)
where b = case mb of
Nothing -> pprHsString l
Just x -> doubleQuotes (text (unpackFS l ++ '@':show x))
pprIntVal :: Integer -> SDoc
-- ^ Print negative integers with parens to be sure it's unambiguous
pprIntVal i | i < 0 = parens (integer i)
| otherwise = integer i
pprIntegerVal :: (SDoc -> SDoc) -> Integer -> SDoc
-- See Note [Printing of literals in Core].
pprIntegerVal add_par i | i < 0 = add_par (integer i)
| otherwise = integer i
{-
Note [Printing of literals in Core]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The function `add_par` is used to wrap parenthesis around negative integers
(`LitInteger`) and labels (`MachLabel`), if they occur in a context requiring
an atomic thing (for example function application).
Although not all Core literals would be valid Haskell, we are trying to stay
as close as possible to Haskell syntax in the printing of Core, to make it
easier for a Haskell user to read Core.
To that end:
* We do print parenthesis around negative `LitInteger`, because we print
`LitInteger` using plain number literals (no prefix or suffix), and plain
number literals in Haskell require parenthesis in contexts like function
application (i.e. `1 - -1` is not valid Haskell).
* We don't print parenthesis around other (negative) literals, because they
aren't needed in GHC/Haskell either (i.e. `1# -# -1#` is accepted by GHC's
parser).
Literal Output Output if context requires
an atom (if different)
------- ------- ----------------------
MachChar 'a'#
MachStr "aaa"#
MachNullAddr "__NULL"
MachInt -1#
MachInt64 -1L#
MachWord 1##
MachWord64 1L##
MachFloat -1.0#
MachDouble -1.0##
LitInteger -1 (-1)
MachLabel "__label" ... ("__label" ...)
-}
{-
************************************************************************
......
......@@ -151,20 +151,19 @@ instance Ord OverLitVal where
compare (HsIsString _ _) (HsFractional _) = GT
instance Outputable HsLit where
-- Use "show" because it puts in appropriate escapes
ppr (HsChar _ c) = pprHsChar c
ppr (HsCharPrim _ c) = pprHsChar c <> char '#'
ppr (HsCharPrim _ c) = pprPrimChar c
ppr (HsString _ s) = pprHsString s
ppr (HsStringPrim _ s) = pprHsBytes s <> char '#'
ppr (HsStringPrim _ s) = pprHsBytes s
ppr (HsInt _ i) = integer i
ppr (HsInteger _ i _) = integer i
ppr (HsRat f _) = ppr f
ppr (HsFloatPrim f) = ppr f <> char '#'
ppr (HsDoublePrim d) = ppr d <> text "##"
ppr (HsIntPrim _ i) = integer i <> char '#'
ppr (HsWordPrim _ w) = integer w <> text "##"
ppr (HsInt64Prim _ i) = integer i <> text "L#"
ppr (HsWord64Prim _ w) = integer w <> text "L##"
ppr (HsFloatPrim f) = ppr f <> primFloatSuffix
ppr (HsDoublePrim d) = ppr d <> primDoubleSuffix
ppr (HsIntPrim _ i) = pprPrimInt i
ppr (HsWordPrim _ w) = pprPrimWord w
ppr (HsInt64Prim _ i) = pprPrimInt64 i
ppr (HsWord64Prim _ w) = pprPrimWord64 w
-- in debug mode, print the expression that it's resolved to, too
instance OutputableBndr id => Outputable (HsOverLit id) where
......
......@@ -562,13 +562,13 @@ Consider this code:
This optimises to:
Shift.$wgo = \ (w_sCS :: GHC.Prim.Int#) (w1_sCT :: [GHC.Types.Bool]) ->
case w1_sCT of _ {
[] -> __word 0;
[] -> 0##;
: x_aAW xs_aAX ->
case x_aAW of _ {
GHC.Types.False ->
case w_sCS of wild2_Xh {
__DEFAULT -> Shift.$wgo (GHC.Prim.+# wild2_Xh 1) xs_aAX;
9223372036854775807 -> __word 0 };
9223372036854775807 -> 0## };
GHC.Types.True ->
case GHC.Prim.>=# w_sCS 64 of _ {
GHC.Types.False ->
......@@ -576,17 +576,17 @@ Shift.$wgo = \ (w_sCS :: GHC.Prim.Int#) (w1_sCT :: [GHC.Types.Bool]) ->
__DEFAULT ->
case Shift.$wgo (GHC.Prim.+# wild3_Xh 1) xs_aAX of ww_sCW { __DEFAULT ->
GHC.Prim.or# (GHC.Prim.narrow32Word#
(GHC.Prim.uncheckedShiftL# (__word 1) wild3_Xh))
(GHC.Prim.uncheckedShiftL# 1## wild3_Xh))
ww_sCW
};
9223372036854775807 ->
GHC.Prim.narrow32Word#
!!!!--> (GHC.Prim.uncheckedShiftL# (__word 1) 9223372036854775807)
!!!!--> (GHC.Prim.uncheckedShiftL# 1## 9223372036854775807)
};
GHC.Types.True ->
case w_sCS of wild3_Xh {
__DEFAULT -> Shift.$wgo (GHC.Prim.+# wild3_Xh 1) xs_aAX;
9223372036854775807 -> __word 0
9223372036854775807 -> 0##
} } } }
Note the massive shift on line "!!!!". It can't happen, because we've checked
......
......@@ -47,6 +47,10 @@ module Outputable (
pprInfixVar, pprPrefixVar,
pprHsChar, pprHsString, pprHsBytes,
primFloatSuffix, primDoubleSuffix,
pprPrimChar, pprPrimInt, pprPrimWord, pprPrimInt64, pprPrimWord64,
pprFastFilePath,
-- * Controlling the style in which output is printed
......@@ -808,7 +812,7 @@ pprHsChar c | c > '\x10ffff' = char '\\' <> text (show (fromIntegral (ord c) ::
pprHsString :: FastString -> SDoc
pprHsString fs = vcat (map text (showMultiLineString (unpackFS fs)))
-- | Special combinator for showing string literals.
-- | Special combinator for showing bytestring literals.
pprHsBytes :: ByteString -> SDoc
pprHsBytes bs = let escaped = concatMap escape $ BS.unpack bs
in vcat (map text (showMultiLineString escaped)) <> char '#'
......@@ -818,6 +822,27 @@ pprHsBytes bs = let escaped = concatMap escape $ BS.unpack bs
then [c]
else '\\' : show w
-- Postfix modifiers for unboxed literals.
-- See Note [Printing of literals in Core] in `basicTypes/Literal.hs`.
primCharSuffix, primFloatSuffix, primIntSuffix :: SDoc
primDoubleSuffix, primWordSuffix, primInt64Suffix, primWord64Suffix :: SDoc
primCharSuffix = char '#'
primFloatSuffix = char '#'
primIntSuffix = char '#'
primDoubleSuffix = text "##"
primWordSuffix = text "##"
primInt64Suffix = text "L#"
primWord64Suffix = text "L##"
-- | Special combinator for showing unboxed literals.
pprPrimChar :: Char -> SDoc
pprPrimInt, pprPrimWord, pprPrimInt64, pprPrimWord64 :: Integer -> SDoc
pprPrimChar c = pprHsChar c <> primCharSuffix
pprPrimInt i = integer i <> primIntSuffix
pprPrimWord w = integer w <> primWordSuffix
pprPrimInt64 i = integer i <> primInt64Suffix
pprPrimWord64 w = integer w <> primWord64Suffix
---------------------
-- Put a name in parens if it's an operator
pprPrefixVar :: Bool -> SDoc -> SDoc
......
......@@ -6,6 +6,10 @@ T8832:
$(RM) -f T8832.o T8832.hi
'$(TEST_HC)' $(TEST_HC_OPTS) $(T8832_WORDSIZE_OPTS) -O -c -ddump-simpl T8832.hs | grep '#'
T8274:
$(RM) -f T8274.o T8274.hi
'$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl T8274.hs | grep '#'
T7865:
$(RM) -f T7865.o T7865.hi
'$(TEST_HC)' $(TEST_HC_OPTS) -dsuppress-uniques -O2 -c -ddump-simpl T7865.hs | grep expensive
......@@ -13,7 +17,7 @@ T7865:
T3055:
$(RM) -f T3055.o T3055.hi T3055.simpl
'$(TEST_HC)' $(TEST_HC_OPTS) -O -c T3055.hs -ddump-simpl > T3055.simpl
grep 'I# (-28)' T3055.simpl | sed 's/.*\(I# (-28)\).*/\1/'
grep 'I# -28#' T3055.simpl | sed 's/.*\(I# -28#\).*/\1/'
T5658b:
$(RM) -f T5658b.o T5658b.hi
......@@ -79,7 +83,7 @@ simpl021:
.PHONY: T5327
T5327:
$(RM) -f T5327.hi T5327.o
'$(TEST_HC)' $(TEST_HC_OPTS) -c T5327.hs -O -ddump-simpl | grep -c 'GHC.Prim.># 34 '
'$(TEST_HC)' $(TEST_HC_OPTS) -c T5327.hs -O -ddump-simpl | grep -c 'GHC.Prim.># 34# '
.PHONY: T5623
T5623:
......
......@@ -9,8 +9,8 @@ T3717.$wfoo [InlPrag=[0], Occ=LoopBreaker]
T3717.$wfoo =
\ (ww :: GHC.Prim.Int#) ->
case ww of ds {
__DEFAULT -> T3717.$wfoo (GHC.Prim.-# ds 1);
0 -> 0
__DEFAULT -> T3717.$wfoo (GHC.Prim.-# ds 1#);
0# -> 0#
}
end Rec }
......
......@@ -8,8 +8,8 @@ $wxs :: GHC.Prim.Int# -> ()
$wxs =
\ (ww :: GHC.Prim.Int#) ->
case ww of ds1 {
__DEFAULT -> $wxs (GHC.Prim.-# ds1 1);
1 -> GHC.Tuple.()
__DEFAULT -> $wxs (GHC.Prim.-# ds1 1#);
1# -> GHC.Tuple.()
}
end Rec }
......@@ -18,7 +18,8 @@ foo [InlPrag=NOINLINE] :: Int -> ()
foo =
\ (n :: Int) ->
case n of _ [Occ=Dead] { GHC.Types.I# y ->
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# 0 y) of _ [Occ=Dead] {
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# 0# y)
of _ [Occ=Dead] {
False -> GHC.Tuple.();
True -> $wxs y
}
......
......@@ -10,10 +10,10 @@ T4908.f_$s$wf =
case sc of ds {
__DEFAULT ->
case sc2 of ds1 {
__DEFAULT -> T4908.f_$s$wf (-# ds 1) sc1 ds1;
0 -> GHC.Types.True
__DEFAULT -> T4908.f_$s$wf (-# ds 1#) sc1 ds1;
0# -> GHC.Types.True
};
0 -> GHC.Types.True
0# -> GHC.Types.True
}
end Rec }
......@@ -31,12 +31,12 @@ T4908.$wf =
case w of _ [Occ=Dead] { (a, b) ->
case b of _ [Occ=Dead] { I# ds1 ->
case ds1 of ds2 {
__DEFAULT -> T4908.f_$s$wf (-# ds 1) a ds2;
0 -> GHC.Types.True
__DEFAULT -> T4908.f_$s$wf (-# ds 1#) a ds2;
0# -> GHC.Types.True
}
}
};
0 -> GHC.Types.True
0# -> GHC.Types.True
}
f [InlPrag=INLINE[0]] :: Int -> (Int, Int) -> Bool
......
{- HasNoCafRefs, Strictness: m, Unfolding: (C# 'p') -}
{- HasNoCafRefs, Strictness: m, Unfolding: (C# 'q') -}
{- HasNoCafRefs, Strictness: m, Unfolding: (C# 'p'#) -}
{- HasNoCafRefs, Strictness: m, Unfolding: (C# 'q'#) -}
......@@ -19,16 +19,18 @@ foo :: Int -> Int
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
Tmpl= \ (n [Occ=Once!] :: Int) ->
case n of _ [Occ=Dead] { GHC.Types.I# x ->
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# x 5) of _ [Occ=Dead] {
False -> GHC.Types.I# (GHC.Prim.+# x 5);
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# x 5#)
of _ [Occ=Dead] {
False -> GHC.Types.I# (GHC.Prim.+# x 5#);
True -> T4930.foo1
}
}}]
foo =
\ (n :: Int) ->
case n of _ [Occ=Dead] { GHC.Types.I# x ->
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# x 5) of _ [Occ=Dead] {
False -> GHC.Types.I# (GHC.Prim.+# x 5);
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# x 5#)
of _ [Occ=Dead] {
False -> GHC.Types.I# (GHC.Prim.+# x 5#);
True -> T4930.foo1
}
}
......
......@@ -39,7 +39,7 @@ T7360.fun3 :: Int
Str=DmdType m,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
T7360.fun3 = GHC.Types.I# 0
T7360.fun3 = GHC.Types.I# 0#
fun2 :: forall a. [a] -> ((), Int)
[GblId,
......@@ -53,7 +53,7 @@ fun2 :: forall a. [a] -> ((), Int)
case x of wild {
[] -> T7360.fun3;
: _ [Occ=Dead] _ [Occ=Dead] ->
case GHC.List.$wlenAcc @ a wild 0 of ww2 { __DEFAULT ->
case GHC.List.$wlenAcc @ a wild 0# of ww2 { __DEFAULT ->
GHC.Types.I# ww2
}
})}]
......@@ -63,7 +63,7 @@ fun2 =
case x of wild {
[] -> T7360.fun3;
: ds ds1 ->
case GHC.List.$wlenAcc @ a wild 0 of ww2 { __DEFAULT ->
case GHC.List.$wlenAcc @ a wild 0# of ww2 { __DEFAULT ->
GHC.Types.I# ww2
}
})
......
{-# LANGUAGE MagicHash #-}
module T8274 where
import GHC.Prim
data P = Positives Int# Float# Double# Char# Word#
data N = Negatives Int# Float# Double#
p = Positives 42# 4.23# 4.23## '4'# 4##
n = Negatives -4# -4.0# -4.0##
n = T8274.Negatives -4# -4.0# -4.0##
p = T8274.Positives 42# 4.23# 4.23## '4'# 4##
i = GHC.Types.I# 0
i8 = GHC.Int.I8# 0
i16 = GHC.Int.I16# 0
i32 = GHC.Int.I32# 0
i64 = GHC.Int.I64# 0
w = GHC.Types.W# (__word 0)
w8 = GHC.Word.W8# (__word 0)
w16 = GHC.Word.W16# (__word 0)
w32 = GHC.Word.W32# (__word 0)
w64 = GHC.Word.W64# (__word 0)
i = GHC.Types.I# 0#
i8 = GHC.Int.I8# 0#
i16 = GHC.Int.I16# 0#
i32 = GHC.Int.I32# 0#
i64 = GHC.Int.I64# 0#
w = GHC.Types.W# 0##
w8 = GHC.Word.W8# 0##
w16 = GHC.Word.W16# 0##
w32 = GHC.Word.W32# 0##
w64 = GHC.Word.W64# 0##
i = GHC.Types.I# 0
i8 = GHC.Int.I8# 0
i16 = GHC.Int.I16# 0
i32 = GHC.Int.I32# 0
w = GHC.Types.W# (__word 0)
w8 = GHC.Word.W8# (__word 0)
w16 = GHC.Word.W16# (__word 0)
w32 = GHC.Word.W32# (__word 0)
i = GHC.Types.I# 0#
i8 = GHC.Int.I8# 0#
i16 = GHC.Int.I16# 0#
i32 = GHC.Int.I32# 0#
w = GHC.Types.W# 0##
w8 = GHC.Word.W8# 0##
w16 = GHC.Word.W16# 0##
w32 = GHC.Word.W32# 0##
......@@ -191,6 +191,7 @@ test('T8221',
extra_clean(['T8221a.hi', 'T8221a.o']),
run_command,
['$MAKE -s --no-print-directory T8221'])
test('T8274', normal, run_command, ['$MAKE -s --no-print-directory T8274'])
test('T8329', only_ways(['optasm']), multimod_compile, ['T8329','-v0 -O'])
test('T5996',
normal,
......@@ -198,7 +199,7 @@ test('T5996',
['$MAKE -s --no-print-directory T5996'])
test('T8537', normal, compile, [''])
test('T8832',
normal,
expect_fail,
run_command,
['$MAKE -s --no-print-directory T8832 T8832_WORDSIZE_OPTS=' +
('-DT8832_WORDSIZE_64' if wordsize(64) else '')])
......
......@@ -24,20 +24,20 @@ Roman.foo_$s$wgo =
(GHC.Prim.+# (GHC.Prim.+# (GHC.Prim.+# sc1 sc1) sc1) sc1) sc1)
sc1)
sc1 } in
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<=# sc 0)
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<=# sc 0#)
of _ [Occ=Dead] {
False ->
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# sc 100)
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# sc 100#)
of _ [Occ=Dead] {
False ->
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# sc 500)
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# sc 500#)
of _ [Occ=Dead] {
False -> Roman.foo_$s$wgo (GHC.Prim.-# sc 1) (GHC.Prim.+# a a);
True -> Roman.foo_$s$wgo (GHC.Prim.-# sc 3) a
False -> Roman.foo_$s$wgo (GHC.Prim.-# sc 1#) (GHC.Prim.+# a a);
True -> Roman.foo_$s$wgo (GHC.Prim.-# sc 3#) a
};
True -> Roman.foo_$s$wgo (GHC.Prim.-# sc 2) sc1
True -> Roman.foo_$s$wgo (GHC.Prim.-# sc 2#) sc1
};
True -> 0
True -> 0#
}
end Rec }
......@@ -64,23 +64,23 @@ Roman.$wgo =
ipv)
ipv } in
case w of _ [Occ=Dead] {
Nothing -> Roman.foo_$s$wgo 10 a;
Nothing -> Roman.foo_$s$wgo 10# a;
Just n ->
case n of _ [Occ=Dead] { GHC.Types.I# x2 ->
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<=# x2 0)
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<=# x2 0#)
of _ [Occ=Dead] {
False ->
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# x2 100)
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# x2 100#)
of _ [Occ=Dead] {
False ->
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# x2 500)
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# x2 500#)
of _ [Occ=Dead] {
False -> Roman.foo_$s$wgo (GHC.Prim.-# x2 1) (GHC.Prim.+# a a);
True -> Roman.foo_$s$wgo (GHC.Prim.-# x2 3) a
False -> Roman.foo_$s$wgo (GHC.Prim.-# x2 1#) (GHC.Prim.+# a a);
True -> Roman.foo_$s$wgo (GHC.Prim.-# x2 3#) a
};
True -> Roman.foo_$s$wgo (GHC.Prim.-# x2 2) ipv
True -> Roman.foo_$s$wgo (GHC.Prim.-# x2 2#) ipv
};
True -> 0
True -> 0#
}
}
}
......@@ -106,7 +106,7 @@ Roman.foo2 :: Int
Str=DmdType m,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
Roman.foo2 = GHC.Types.I# 6
Roman.foo2 = GHC.Types.I# 6#
Roman.foo1 :: Maybe Int
[GblId,
......@@ -131,7 +131,7 @@ foo :: Int -> Int
foo =
\ (n :: Int) ->
case n of _ [Occ=Dead] { GHC.Types.I# ipv ->
case Roman.foo_$s$wgo ipv 6 of ww { __DEFAULT -> GHC.Types.I# ww }
case Roman.foo_$s$wgo ipv 6# of ww { __DEFAULT -> GHC.Types.I# ww }
}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment