%
\begin{code}
-{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveDataTypeable, DeriveFunctor #-}
-- | CoreSyn holds all the main data types for use by for the Glasgow Haskell Compiler midsection
module CoreSyn (
notSccNote,
-- * Unfolding data types
- Unfolding(..), UnfoldingGuidance(..), UnfoldingSource(..),
- -- Abstract everywhere but in CoreUnfold.lhs
-
+ Unfolding(..), UnfoldingGuidance(..), UnfoldingSource(..),
+ DFunArg(..), dfunArgExprs,
+
-- ** Constructing 'Unfolding's
noUnfolding, evaldUnfolding, mkOtherCon,
unSaturatedOk, needSaturated, boringCxtOk, boringCxtNotOk,
maybeUnfoldingTemplate, otherCons, unfoldingArity,
isValueUnfolding, isEvaldUnfolding, isCheapUnfolding,
isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding,
- isStableUnfolding, isStableUnfolding_maybe,
+ isStableUnfolding, isStableCoreUnfolding_maybe,
isClosedUnfolding, hasSomeUnfolding,
canUnfold, neverUnfoldGuidance, isStableSource,
RuleName, IdUnfoldingFun,
-- ** Operations on 'CoreRule's
- seqRules, ruleArity, ruleName, ruleIdName, ruleActivation_maybe,
+ seqRules, ruleArity, ruleName, ruleIdName, ruleActivation,
setRuleIdName,
- isBuiltinRule, isLocalRule
+ isBuiltinRule, isLocalRule,
+
+ -- * Core vectorisation declarations data type
+ CoreVect(..)
) where
#include "HsVersions.h"
ruleName :: CoreRule -> RuleName
ruleName = ru_name
-ruleActivation_maybe :: CoreRule -> Maybe Activation
-ruleActivation_maybe (BuiltinRule { }) = Nothing
-ruleActivation_maybe (Rule { ru_act = act }) = Just act
+ruleActivation :: CoreRule -> Activation
+ruleActivation (BuiltinRule { }) = AlwaysActive
+ruleActivation (Rule { ru_act = act }) = act
-- | The 'Name' of the 'Id.Id' at the head of the rule left hand side
ruleIdName :: CoreRule -> Name
%************************************************************************
+%* *
+\subsection{Vectorisation declarations}
+%* *
+%************************************************************************
+
+Representation of desugared vectorisation declarations that are fed to the vectoriser (via
+'ModGuts').
+
+\begin{code}
+data CoreVect = Vect Id (Maybe CoreExpr)
+\end{code}
+
+
+%************************************************************************
%* *
Unfoldings
%* *
DataCon -- The dictionary data constructor (possibly a newtype datacon)
- [CoreExpr] -- The [CoreExpr] are the superclasses and methods [op1,op2],
- -- in positional order.
- -- They are usually variables, but can be trivial expressions
- -- instead (e.g. a type application).
+ [DFunArg CoreExpr] -- Specification of superclasses and methods, in positional order
| CoreUnfolding { -- An unfolding for an Id with no pragma,
-- or perhaps a NOINLINE pragma
-- uf_guidance: Tells us about the /size/ of the unfolding template
------------------------------------------------
-data UnfoldingSource
+data DFunArg e -- Given (df a b d1 d2 d3)
+ = DFunPolyArg e -- Arg is (e a b d1 d2 d3)
+ | DFunConstArg e -- Arg is e, which is constant
+ | DFunLamArg Int -- Arg is one of [a,b,d1,d2,d3], zero indexed
+ deriving( Functor )
+
+ -- 'e' is often CoreExpr, which are usually variables, but can
+ -- be trivial expressions instead (e.g. a type application).
+
+dfunArgExprs :: [DFunArg e] -> [e]
+dfunArgExprs [] = []
+dfunArgExprs (DFunPolyArg e : as) = e : dfunArgExprs as
+dfunArgExprs (DFunConstArg e : as) = e : dfunArgExprs as
+dfunArgExprs (DFunLamArg {} : as) = dfunArgExprs as
+
+
+------------------------------------------------
+data UnfoldingSource
= InlineRhs -- The current rhs of the function
-- Replace uf_tmpl each time around
| InlineStable -- From an INLINE or INLINABLE pragma
- -- Do not replace uf_tmpl; instead, keep it unchanged
+ -- INLINE if guidance is UnfWhen
+ -- INLINABLE if guidance is UnfIfGoodArgs/UnfoldNever
+ -- (well, technically an INLINABLE might be made
+ -- UnfWhen if it was small enough, and then
+ -- it will behave like INLINE outside the current
+ -- module, but that is the way automatic unfoldings
+ -- work so it is consistent with the intended
+ -- meaning of INLINABLE).
+ --
+ -- uf_tmpl may change, but only as a result of
+ -- gentle simplification, it doesn't get updated
+ -- to the current RHS during compilation as with
+ -- InlineRhs.
+ --
-- See Note [InlineRules]
| InlineCompulsory -- Something that *has* no binding, so you *must* inline it
expandUnfolding_maybe (CoreUnfolding { uf_expandable = True, uf_tmpl = rhs }) = Just rhs
expandUnfolding_maybe _ = Nothing
-isStableUnfolding_maybe :: Unfolding -> Maybe (UnfoldingSource, Bool)
-isStableUnfolding_maybe (CoreUnfolding { uf_src = src, uf_guidance = guide })
- | isStableSource src
- = Just (src, unsat_ok)
- where
- unsat_ok = case guide of
- UnfWhen unsat_ok _ -> unsat_ok
- _ -> needSaturated
-isStableUnfolding_maybe _ = Nothing
+isStableCoreUnfolding_maybe :: Unfolding -> Maybe UnfoldingSource
+isStableCoreUnfolding_maybe (CoreUnfolding { uf_src = src })
+ | isStableSource src = Just src
+isStableCoreUnfolding_maybe _ = Nothing
isCompulsoryUnfolding :: Unfolding -> Bool
isCompulsoryUnfolding (CoreUnfolding { uf_src = InlineCompulsory }) = True
projects / ghc-hetmet.git / blobdiff