Added a VECTORISE pragma

[ghc-hetmet.git] / compiler / coreSyn / CoreSyn.lhs

diff --git a/compiler/coreSyn/CoreSyn.lhs b/compiler/coreSyn/CoreSyn.lhs
index 2dda733..603b745 100644 (file)
--- a/compiler/coreSyn/CoreSyn.lhs
+++ b/compiler/coreSyn/CoreSyn.lhs
@@ -4,7 +4,7 @@
 %
 
 \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 (
@@ -37,9 +37,9 @@ 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,
@@ -72,7 +72,10 @@ module CoreSyn (
        -- ** Operations on 'CoreRule's 
        seqRules, ruleArity, ruleName, ruleIdName, ruleActivation,
        setRuleIdName,
-       isBuiltinRule, isLocalRule
+       isBuiltinRule, isLocalRule,
+
+       -- * Core vectorisation declarations data type
+       CoreVect(..)
     ) where
 
 #include "HsVersions.h"
@@ -402,6 +405,20 @@ setRuleIdName nm ru = ru { ru_fn = nm }
 
 
 %************************************************************************
+%*                                                                      *
+\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
 %*                                                                     *
@@ -437,10 +454,7 @@ data Unfolding
 
         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
@@ -478,13 +492,30 @@ data Unfolding
   --  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 
                        --   INLINE     if guidance is UnfWhen
-                       --   INLINABLE  if guidance is UnfIfGoodArgs
+                       --   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