Commit 0b70ec0c authored by Facundo Domínguez's avatar Facundo Domínguez
Browse files

Have static pointers work with -fno-full-laziness.

Summary:
Before this patch, static pointers wouldn't be floated to
the top-level.

Test Plan: ./validate

Reviewers: simonpj, bgamari, austin

Subscribers: mboes, thomie

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

GHC Trac Issues: #11656
parent 795be0ea
......@@ -204,16 +204,20 @@ getCoreToDo dflags
[simpl_phase 0 ["post-worker-wrapper"] max_iter]
))
-- Static forms are moved to the top level with the FloatOut pass.
-- See Note [Grand plan for static forms].
static_ptrs_float_outwards =
runWhen static_ptrs $ CoreDoFloatOutwards FloatOutSwitches
{ floatOutLambdas = Just 0
, floatOutConstants = True
, floatOutOverSatApps = False
, floatToTopLevelOnly = True
}
core_todo =
if opt_level == 0 then
[ vectorisation,
-- Static forms are moved to the top level with the FloatOut pass.
-- See Note [Grand plan for static forms].
runWhen static_ptrs $ CoreDoFloatOutwards FloatOutSwitches {
floatOutLambdas = Just 0,
floatOutConstants = True,
floatOutOverSatApps = False,
floatToTopLevelOnly = True },
static_ptrs_float_outwards,
CoreDoSimplify max_iter
(base_mode { sm_phase = Phase 0
, sm_names = ["Non-opt simplification"] })
......@@ -238,12 +242,12 @@ getCoreToDo dflags
-- so that overloaded functions have all their dictionary lambdas manifest
runWhen do_specialise CoreDoSpecialising,
runWhen full_laziness $
if full_laziness then
CoreDoFloatOutwards FloatOutSwitches {
floatOutLambdas = Just 0,
floatOutConstants = True,
floatOutOverSatApps = False,
floatToTopLevelOnly = False },
floatToTopLevelOnly = False }
-- Was: gentleFloatOutSwitches
--
-- I have no idea why, but not floating constants to
......@@ -261,6 +265,10 @@ getCoreToDo dflags
-- difference at all to performance if we do it here,
-- but maybe we save some unnecessary to-and-fro in
-- the simplifier.
else
-- Even with full laziness turned off, we still need to float static
-- forms to the top level. See Note [Grand plan for static forms].
static_ptrs_float_outwards,
simpl_phases,
......
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE StaticPointers #-}
-- | A test to use symbols produced by the static form.
module Main(main) where
import Data.Typeable
import GHC.StaticPtr
main :: IO ()
main = do
lookupKey (static (id . id)) >>= \f -> print $ f (1 :: Int)
lookupKey (static method :: StaticPtr (Char -> Int)) >>= \f -> print $ f 'a'
print $ deRefStaticPtr (static g)
print $ deRefStaticPtr p0 'a'
print $ deRefStaticPtr (static t_field) $ T 'b'
where
g :: String
g = "found"
lookupKey :: StaticPtr a -> IO a
lookupKey p = unsafeLookupStaticPtr (staticKey p) >>= \case
Just p -> return $ deRefStaticPtr p
Nothing -> error $ "couldn't find " ++ show (staticPtrInfo p)
p0 :: Typeable a => StaticPtr (a -> a)
p0 = static (\x -> x)
data T a = T { t_field :: a }
deriving Typeable
class C1 a where
method :: a -> Int
instance C1 Char where
method = const 0
......@@ -119,6 +119,8 @@ test('T8256', normal, compile_and_run, ['-dcore-lint -O1'])
test('T6084',normal, compile_and_run, ['-O2'])
test('CgStaticPointers', [when(doing_ghci(), extra_hc_opts('-fobject-code'))],
compile_and_run, [''])
test('CgStaticPointersNoFullLazyness', [when(doing_ghci(), extra_hc_opts('-fobject-code'))],
compile_and_run, ['-O -fno-full-laziness'])
test('StaticArraySize', [when(doing_ghci(), extra_hc_opts('-fobject-code'))],
compile_and_run, ['-O2'])
test('StaticByteArraySize', normal, compile_and_run, ['-O2'])
......
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