X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=ghc%2Fcompiler%2FndpFlatten%2FFlattening.hs;h=18daaa632395071d485396e8d28cc7749e9ed9c8;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=393762fe40cec64aa85b72997fb67082b5520027;hpb=23f40f0e9be6d4aa5cf9ea31d73f4013f8e7b4bd;p=ghc-hetmet.git

diff --git a/ghc/compiler/ndpFlatten/Flattening.hs b/ghc/compiler/ndpFlatten/Flattening.hs
index 393762f..18daaa6 100644
--- a/ghc/compiler/ndpFlatten/Flattening.hs
+++ b/ghc/compiler/ndpFlatten/Flattening.hs
@@ -63,16 +63,17 @@ import FlattenMonad (Flatten, runFlatten, mkBind, extendContext, packContext,
 		     mk'indexOfP,mk'eq,mk'neq) 
 
 -- GHC
-import CmdLineOpts  (opt_Flatten)
+import TcType	    ( tcIsForAllTy, tcView )
+import TypeRep	    ( Type(..) )
+import StaticFlags  (opt_Flatten)
 import Panic        (panic)
 import ErrUtils     (dumpIfSet_dyn)
 import UniqSupply   (mkSplitUniqSupply)
-import CmdLineOpts  (DynFlag(..))
+import DynFlags  (DynFlag(..))
 import Literal      (Literal, literalType)
 import Var	    (Var(..), idType, isTyVar)
 import Id	    (setIdType)
 import DataCon	    (DataCon, dataConTag)
-import TypeRep      (Type(..))
 import HscTypes	    ( ModGuts(..), ModGuts, HscEnv(..), hscEPS )
 import CoreFVs	    (exprFreeVars)
 import CoreSyn	    (Expr(..), Bind(..), Alt(..), AltCon(..), Note(..),
@@ -246,7 +247,7 @@ vectorise (App expr arg) =
     (vexpr, vexprTy) <-  vectorise expr
     (varg,  vargTy)  <-  vectorise arg
 
-    if (isPolyType vexprTy)
+    if (tcIsForAllTy vexprTy)
       then do
         let resTy =  applyTypeToArg vexprTy varg
         return (App vexpr varg, resTy)
@@ -256,13 +257,6 @@ vectorise (App expr arg) =
         let resTy    = applyTypeToArg t1 varg   
         return  ((App vexpr' varg), resTy)  -- apply the first component of
                                             -- the vectorized function
-  where
-    isPolyType t =  
-        (case t  of
-           (ForAllTy _ _)  -> True
-           (NoteTy _ nt)   -> isPolyType nt
-           _               -> False)
-    
 
 vectorise  e@(Lam b expr)
   | isTyVar b
@@ -285,7 +279,6 @@ vectorise (Let bind body) =
     (vbody, vbodyTy) <- vectorise body
     return ((Let vbind vbody), vbodyTy)
 
--- gaw 2004
 vectorise (Case expr b ty alts) =
   do 
     (vexpr, vexprTy) <- vectorise expr
@@ -318,6 +311,10 @@ myShowTy (TyConApp _ t) =
 -}
 
 vectoriseTy :: Type -> Type 
+vectoriseTy ty | Just ty' <- tcView ty = vectoriseTy ty'
+	-- Look through notes and synonyms
+	-- NB: This will discard notes and synonyms, of course
+	-- ToDo: retain somehow?
 vectoriseTy t@(TyVarTy v)      =  t
 vectoriseTy t@(AppTy t1 t2)    = 
   AppTy (vectoriseTy t1) (vectoriseTy t2)
@@ -328,8 +325,6 @@ vectoriseTy t@(FunTy t1 t2)    =
                      (liftTy t)]
 vectoriseTy  t@(ForAllTy v ty)  = 
   ForAllTy v (vectoriseTy  ty)
-vectoriseTy t@(NoteTy note ty) =  -- FIXME: is the note still valid after
-  NoteTy note  (vectoriseTy ty)   --   this or should we just throw it away
 vectoriseTy  t =  t
 
 
@@ -337,9 +332,9 @@ vectoriseTy  t =  t
 --    on the *top level* (is this sufficient???)
 
 liftTy:: Type -> Type
+liftTy ty | Just ty' <- tcView ty = liftTy ty'
 liftTy (FunTy t1 t2)   = FunTy (liftTy t1) (liftTy t2)
 liftTy (ForAllTy tv t) = ForAllTy tv (liftTy t)
-liftTy (NoteTy n t)    = NoteTy n $ liftTy t
 liftTy  t              = mkPArrTy t
 
 
@@ -756,7 +751,7 @@ mkIndexOfExprDft idType b lits =
 
 -- create a back-permute binder
 --
--- * `mkDftBackpermute ty indexArrayVar srcArrayVar dftArrayVar' creates a
+--  * `mkDftBackpermute ty indexArrayVar srcArrayVar dftArrayVar' creates a
 --   Core binding of the form
 --
 --     x = bpermuteDftP indexArrayVar srcArrayVar dftArrayVar