...
 
Commits (4)
This diff is collapsed.
module CoreUnfold (
mkUnfolding
) where
import GhcPrelude
import CoreSyn
import DynFlags
mkUnfolding :: DynFlags
-> UnfoldingSource
-> Bool
-> Bool
-> CoreExpr
-> Unfolding
......@@ -17,6 +17,7 @@ is not deterministic.
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wall #-}
module UniqDFM (
......@@ -138,6 +139,16 @@ data UniqDFM ele =
-- time. See Note [Overflow on plusUDFM]
deriving (Data, Functor)
-- | Deterministic, in O(n log n).
instance Foldable UniqDFM where
foldr = foldUDFM
-- | Deterministic, in O(n log n).
instance Traversable UniqDFM where
traverse f = fmap listToUDFM_Directly
. traverse (\(u,a) -> (u,) <$> f a)
. udfmToList
emptyUDFM :: UniqDFM elt
emptyUDFM = UDFM M.empty 0
......
......@@ -26,7 +26,8 @@ of arguments of combining function.
module UniqFM (
-- * Unique-keyed mappings
UniqFM, -- abstract type
UniqFM, -- abstract type
NonDetUniqFM(..), -- wrapper for opting into nondeterminism
-- ** Manipulating those mappings
emptyUFM,
......@@ -84,9 +85,8 @@ import Data.Functor.Classes (Eq1 (..))
newtype UniqFM ele = UFM (M.IntMap ele)
deriving (Data, Eq, Functor)
-- We used to derive Traversable and Foldable, but they were nondeterministic
-- and not obvious at the call site. You can use explicit nonDetEltsUFM
-- and fold a list if needed.
-- Nondeterministic Foldable and Traversable instances are accessible through
-- use of the 'NonDetUniqFM' wrapper.
-- See Note [Deterministic UniqFM] in UniqDFM to learn about determinism.
emptyUFM :: UniqFM elt
......@@ -333,6 +333,29 @@ nonDetFoldUFM_Directly k z (UFM m) = M.foldrWithKey (k . getUnique) z m
nonDetUFMToList :: UniqFM elt -> [(Unique, elt)]
nonDetUFMToList (UFM m) = map (\(k, v) -> (getUnique k, v)) $ M.toList m
-- | A wrapper around 'UniqFM' with the sole purpose of informing call sites
-- that the provided 'Foldable' and 'Traversable' instances are
-- nondeterministic.
-- If you use this please provide a justification why it doesn't introduce
-- nondeterminism.
-- See Note [Deterministic UniqFM] in UniqDFM to learn about determinism.
newtype NonDetUniqFM ele = NonDetUniqFM { getNonDet :: UniqFM ele }
deriving (Functor)
-- | Inherently nondeterministic.
-- If you use this please provide a justification why it doesn't introduce
-- nondeterminism.
-- See Note [Deterministic UniqFM] in UniqDFM to learn about determinism.
instance Foldable NonDetUniqFM where
foldr f z (NonDetUniqFM (UFM m)) = foldr f z m
-- | Inherently nondeterministic.
-- If you use this please provide a justification why it doesn't introduce
-- nondeterminism.
-- See Note [Deterministic UniqFM] in UniqDFM to learn about determinism.
instance Traversable NonDetUniqFM where
traverse f (NonDetUniqFM (UFM m)) = NonDetUniqFM . UFM <$> traverse f m
ufmToIntMap :: UniqFM elt -> M.IntMap elt
ufmToIntMap (UFM m) = m
......
......@@ -52,7 +52,6 @@ import GHC.Real (div, fromIntegral)
import GHC.Show (Show)
import GHC.Word (Word32, Word64)
import GHC.Windows
import GHC.Prim.Ext
#if defined(mingw32_HOST_OS)
# if defined(i386_HOST_ARCH)
......
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"#)
......