...
 
Commits (4)
  • Andreas Klebinger's avatar
    Rework the Binary Integer instance. · a38104b4
    Andreas Klebinger authored
    We used to serialise large integers as strings. Now they are serialized
    as a list of Bytes.
    
    This changes the size for a Integer in the higher 64bit range from 77 to
    9 bytes when written to disk.
    
    The impact on the general case is small (<1% for interface files) as we
    don't use many Integers. But for code that uses many this should be a
    nice benefit.
    a38104b4
  • Andreas Klebinger's avatar
    Use os.devnull instead of '/dev/null' in the testsuite driver. · aa4d8b07
    Andreas Klebinger authored
    The later caused issues on windows by being translated into
    "\\dev\\null" and python then trying to open this non-existant file.
    
    So we now use os.devnull inside python and convert it to "/dev/null"
    when calling out to the shell, which is bound to run in a unix like
    environment.
    
    This fixes an issue a test producing unexpected stderr output failed
    with a framework failure instead of showing a diff of the output.
    aa4d8b07
  • Tobias Dammers's avatar
    Add test cases for #16615 · 7a91b2bb
    Tobias Dammers authored
    7a91b2bb
  • Tobias Dammers's avatar
    Make add_info attach unfoldings (#16615) · f8c6238d
    Tobias Dammers authored
    f8c6238d
This diff is collapsed.
module CoreUnfold (
mkUnfolding
) where
import GhcPrelude
import CoreSyn
import DynFlags
mkUnfolding :: DynFlags
-> UnfoldingSource
-> Bool
-> Bool
-> CoreExpr
-> Unfolding
......@@ -4,6 +4,7 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
-- We always optimise this, otherwise performance of a non-optimised
......@@ -79,11 +80,12 @@ import qualified Data.ByteString.Unsafe as BS
import Data.IORef
import Data.Char ( ord, chr )
import Data.Time
import Data.List (unfoldr)
import Type.Reflection
import Type.Reflection.Unsafe
import Data.Kind (Type)
import GHC.Exts (TYPE, RuntimeRep(..), VecCount(..), VecElem(..))
import Control.Monad ( when )
import Control.Monad ( when, (<$!>) )
import System.IO as IO
import System.IO.Unsafe ( unsafeInterleaveIO )
import System.IO.Error ( mkIOError, eofErrorType )
......@@ -502,40 +504,90 @@ instance Binary DiffTime where
get bh = do r <- get bh
return $ fromRational r
--to quote binary-0.3 on this code idea,
--
-- TODO This instance is not architecture portable. GMP stores numbers as
-- arrays of machine sized words, so the byte format is not portable across
-- architectures with different endianness and word size.
--
-- This makes it hard (impossible) to make an equivalent instance
-- with code that is compilable with non-GHC. Do we need any instance
-- Binary Integer, and if so, does it have to be blazing fast? Or can
-- we just change this instance to be portable like the rest of the
-- instances? (binary package has code to steal for that)
--
-- yes, we need Binary Integer and Binary Rational in basicTypes/Literal.hs
{-
Finally - a reasonable portable Integer instance.
We used to encode values in the Int32 range as such,
falling back to a string of all things. In either case
we stored a tag byte to discriminate between the two cases.
This made some sense as it's highly portable but also not very
efficient.
However GHC stores a surprisingly large number off large Integer
values. In the examples looked at between 25% and 50% of Integers
serialized were outside of the Int32 range.
Consider a valie like `2724268014499746065`, some sort of hash
actually generated by GHC.
In the old scheme this was encoded as a list of 19 chars. This
gave a size of 77 Bytes, one for the length of the list and 76
since we encod chars as Word32 as well.
We can easily do better. The new plan is:
* Start with a tag byte
* 0 => Int32 value
* 1 => Int64
* 2 => Negative large interger
* 3 => Positive large integer
* Followed by the value:
* Int32/64 is encoded as usual
* Large integers are encoded as a list of bytes (Word8).
We use Data.Bits which defines a bit order independent of the representation.
Values are stored LSB first.
This means our example value `2724268014499746065` is now only 10 bytes large.
* One byte tag
* One byte for the length of the [Word8] list.
* 8 bytes for the actual date.
The new scheme also does not depend in any way on
architecture specific details.
The instance is used for in Binary Integer and Binary Rational in basicTypes/Literal.hs
-}
instance Binary Integer where
put_ bh i
| i >= lo32 && i <= hi32 = do
putWord8 bh 0
put_ bh (fromIntegral i :: Int32)
| otherwise = do
| i >= lo64 && i <= hi64 = do
putWord8 bh 1
put_ bh (show i)
put_ bh (fromIntegral i :: Int64)
| otherwise = do
if i < 0
then putWord8 bh 2
else putWord8 bh 3
put_ bh (unroll $ abs i)
where
lo32 = fromIntegral (minBound :: Int32)
hi32 = fromIntegral (maxBound :: Int32)
lo64 = fromIntegral (minBound :: Int64)
hi64 = fromIntegral (maxBound :: Int64)
get bh = do
int_kind <- getWord8 bh
case int_kind of
0 -> fromIntegral <$> (get bh :: IO Int32)
_ -> do str <- get bh
case reads str of
[(i, "")] -> return i
_ -> fail ("Binary integer: got " ++ show str)
0 -> fromIntegral <$!> (get bh :: IO Int32)
1 -> fromIntegral <$!> (get bh :: IO Int64)
-- Large integer
_ -> do
!i <- roll <$!> (get bh :: IO [Word8]) :: IO Integer
if int_kind == 2 then return $! negate i -- Negative
else return $! i -- Positive
unroll :: (Integral a, Bits a) => a -> [Word8]
unroll = unfoldr step
where
step 0 = Nothing
step i = Just (fromIntegral i, i `shiftR` 8)
roll :: (Integral a, Bits a) => [Word8] -> a
roll = foldl' unstep 0 . reverse
where
unstep a b = a `shiftL` 8 .|. fromIntegral b
{-
-- This code is currently commented out.
......
......@@ -1817,7 +1817,8 @@ def compare_outputs(way: WayName,
expected_normalised_path = in_testdir(expected_normalised_file)
else:
expected_str = ''
expected_normalised_path = Path('/dev/null')
# See Note [Null device handling]
expected_normalised_path = Path(os.devnull)
actual_raw = read_no_crs(actual_path)
actual_str = normaliser(actual_raw)
......@@ -1829,7 +1830,8 @@ def compare_outputs(way: WayName,
if config.verbose >= 1 and _expect_pass(way):
print('Actual ' + kind + ' output differs from expected:')
if expected_normalised_path != '/dev/null':
# See Note [Null device handling]
if expected_normalised_path != Path(os.devnull):
write_file(expected_normalised_path, expected_str)
actual_normalised_path = add_suffix(actual_path, 'normalised')
......@@ -1837,7 +1839,7 @@ def compare_outputs(way: WayName,
if config.verbose >= 1 and _expect_pass(way):
# See Note [Output comparison].
r = runCmd('diff -uw "{0}" "{1}"'.format(expected_normalised_path,
r = runCmd('diff -uw "{0}" "{1}"'.format(null2unix_null(expected_normalised_path),
actual_normalised_path),
stdout=diff_file,
print_output=True)
......@@ -1845,7 +1847,7 @@ def compare_outputs(way: WayName,
# If for some reason there were no non-whitespace differences,
# then do a full diff
if r == 0:
r = runCmd('diff -u "{0}" "{1}"'.format(expected_normalised_path,
r = runCmd('diff -u "{0}" "{1}"'.format(null2unix_null(expected_normalised_path),
actual_normalised_path),
stdout=diff_file,
print_output=True)
......@@ -1930,6 +1932,26 @@ def grep_output(normaliser: OutputNormalizer, pattern_file, actual_file, is_subs
# on the `diff` program to ignore whitespace changes as much as
# possible (#10152).
# Note [Null device handling]
#
# On windows the null device is 'nul' instead of '/dev/null'.
# This can in principle be easily solved by using os.devnull.
# Not doing so causes issues when python tries to read/write/open
# the null device.
#
# However this still leads to a problem when executing shell
# commands in the msys environment. Which again expect '/dev/null'.
#
# So what we do is use os.devnull and convert it to the string
# '/dev/null' for shell commands which are bound to run in a
# unix-like environment.
def null2unix_null(f: Path) -> str:
if f == Path(os.devnull):
return ('/dev/null')
else:
return f.as_posix()
def normalise_whitespace(s: str) -> str:
# Merge contiguous whitespace characters into a single space.
return ' '.join(s.split())
......
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=True)}]
f = \ (@ p) _ [Occ=Dead] -> GHC.Types.True
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 80 30}]
module T16615
where
f :: Int -> Bool
f i = if i == 0 then True else g (pred i)
g :: Int -> Bool
g i = if i == 0 then False else f (pred i)
==================== Desugar (after optimization) ====================
Result size of Desugar (after optimization)
= {terms: 36, types: 13, coercions: 0, joins: 0/0}
-- RHS size: {terms: 5, types: 0, coercions: 0, joins: 0/0}
T16615.$trModule :: GHC.Types.Module
[LclIdX,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 80 30}]
T16615.$trModule
= GHC.Types.Module
(GHC.Types.TrNameS "main"#) (GHC.Types.TrNameS "T16615"#)
Rec {
-- RHS size: {terms: 14, types: 4, coercions: 0, joins: 0/0}
g :: Int -> Bool
[LclIdX,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 120 10}]
g = \ (i :: Int) ->
case == @ Int GHC.Classes.$fEqInt i (GHC.Types.I# 0#) of {
False -> f (pred @ Int GHC.Enum.$fEnumInt i);
True -> GHC.Types.False
}
-- RHS size: {terms: 14, types: 4, coercions: 0, joins: 0/0}
f [Occ=LoopBreaker] :: Int -> Bool
[LclIdX,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 120 10}]
f = \ (i :: Int) ->
case == @ Int GHC.Classes.$fEqInt i (GHC.Types.I# 0#) of {
False -> g (pred @ Int GHC.Enum.$fEnumInt i);
True -> GHC.Types.True
}
end Rec }
......@@ -107,3 +107,4 @@ test('T14773a', normal, compile, ['-Wincomplete-patterns'])
test('T14773b', normal, compile, ['-Wincomplete-patterns'])
test('T14815', [], makefile_test, ['T14815'])
test('T13208', [], makefile_test, ['T13208'])
test('T16615', normal, compile, ['-ddump-ds -dsuppress-uniques'])
......@@ -5,13 +5,18 @@ Result size of Desugar (after optimization)
-- RHS size: {terms: 6, types: 11, coercions: 0, joins: 0/0}
f :: forall a b. (a ~ b) => a -> b -> Bool
[LclIdX]
[LclIdX,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=True)}]
f = \ (@ a) (@ b) _ [Occ=Dead] _ [Occ=Dead] _ [Occ=Dead] ->
GHC.Types.True
-- RHS size: {terms: 5, types: 0, coercions: 0, joins: 0/0}
T13032.$trModule :: GHC.Types.Module
[LclIdX]
[LclIdX,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 80 30}]
T13032.$trModule
= GHC.Types.Module
(GHC.Types.TrNameS "main"#) (GHC.Types.TrNameS "T13032"#)
......