Finish breaking up VectBuiltIn and VectMonad, and add comments

[ghc-hetmet.git] / compiler / vectorise / Vectorise / Monad / InstEnv.hs

diff --git a/compiler/vectorise/Vectorise/Monad/InstEnv.hs b/compiler/vectorise/Vectorise/Monad/InstEnv.hs
new file mode 100644 (file)
index 0000000..7bfdc23
--- /dev/null
+++ b/compiler/vectorise/Vectorise/Monad/InstEnv.hs
@@ -0,0 +1,80 @@
+
+module Vectorise.Monad.InstEnv (
+       lookupInst,
+       lookupFamInst
+) where
+import Vectorise.Monad.Global
+import Vectorise.Monad.Base
+import Vectorise.Env
+
+import FamInstEnv
+import InstEnv
+import Class
+import Type
+import TyCon
+import Outputable
+
+
+#include "HsVersions.h"
+
+
+getInstEnv :: VM (InstEnv, InstEnv)
+getInstEnv = readGEnv global_inst_env
+
+getFamInstEnv :: VM FamInstEnvs
+getFamInstEnv = readGEnv global_fam_inst_env
+
+
+-- Look up the dfun of a class instance.
+--
+-- The match must be unique - ie, match exactly one instance - but the 
+-- type arguments used for matching may be more specific than those of 
+-- the class instance declaration.  The found class instances must not have
+-- any type variables in the instance context that do not appear in the
+-- instances head (i.e., no flexi vars); for details for what this means,
+-- see the docs at InstEnv.lookupInstEnv.
+--
+lookupInst :: Class -> [Type] -> VM (DFunId, [Type])
+lookupInst cls tys
+  = do { instEnv <- getInstEnv
+       ; case lookupInstEnv instEnv cls tys of
+          ([(inst, inst_tys)], _) 
+             | noFlexiVar -> return (instanceDFunId inst, inst_tys')
+             | otherwise  -> pprPanic "VectMonad.lookupInst: flexi var: " 
+                                      (ppr $ mkTyConApp (classTyCon cls) tys)
+             where
+               inst_tys'  = [ty | Right ty <- inst_tys]
+               noFlexiVar = all isRight inst_tys
+          _other         ->
+             pprPanic "VectMonad.lookupInst: not found " (ppr cls <+> ppr tys)
+       }
+  where
+    isRight (Left  _) = False
+    isRight (Right _) = True
+
+-- Look up the representation tycon of a family instance.
+--
+-- The match must be unique - ie, match exactly one instance - but the 
+-- type arguments used for matching may be more specific than those of 
+-- the family instance declaration.
+--
+-- Return the instance tycon and its type instance.  For example, if we have
+--
+--  lookupFamInst 'T' '[Int]' yields (':R42T', 'Int')
+--
+-- then we have a coercion (ie, type instance of family instance coercion)
+--
+--  :Co:R42T Int :: T [Int] ~ :R42T Int
+--
+-- which implies that :R42T was declared as 'data instance T [a]'.
+--
+lookupFamInst :: TyCon -> [Type] -> VM (TyCon, [Type])
+lookupFamInst tycon tys
+  = ASSERT( isOpenTyCon tycon )
+    do { instEnv <- getFamInstEnv
+       ; case lookupFamInstEnv instEnv tycon tys of
+          [(fam_inst, rep_tys)] -> return (famInstTyCon fam_inst, rep_tys)
+          _other                -> 
+             pprPanic "VectMonad.lookupFamInst: not found: " 
+                      (ppr $ mkTyConApp tycon tys)
+       }