X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=utils%2Fext-core%2FLanguage%2FCore%2FCheck.hs;fp=utils%2Fext-core%2FLanguage%2FCore%2FCheck.hs;h=3ae94e3697eb5641b42a9a1cc892c80a5c085d79;hp=9f7a27670d011035af3f82d9e72304cb9bd02634;hb=ee69a45c027e2a9fefd9a97bfd64e78b49d0ecbe;hpb=5a4c6ef6e909fbd978ff81bb3453489e884d1885

diff --git a/utils/ext-core/Language/Core/Check.hs b/utils/ext-core/Language/Core/Check.hs
index 9f7a276..3ae94e3 100644
--- a/utils/ext-core/Language/Core/Check.hs
+++ b/utils/ext-core/Language/Core/Check.hs
@@ -5,7 +5,7 @@ module Language.Core.Check(
   primCoercionError, 
   Menv, Venv, Tvenv, Envs(..),
   CheckRes(..), splitTy, substl,
-  mkTypeEnvsNoChecking) where
+  mkTypeEnvsNoChecking, NtEnv, mkNtEnv) where
 
 --import Debug.Trace
 
@@ -18,6 +18,7 @@ import Language.Core.Environments
 
 import Control.Monad.Reader
 import Data.List
+import qualified Data.Map as M
 import Data.Maybe
 
 {- Checking is done in a simple error monad.  In addition to
@@ -632,3 +633,17 @@ primCoercionError s = error $ "Bad coercion application: " ++ show s
 reportError :: Show a => a -> String -> b
 reportError e s = error $ ("Core type error: checkExpr failed with "
                    ++ s ++ " and " ++ show e)
+
+type NtEnv  = M.Map Tcon CoercionKind
+
+mkNtEnv :: Menv -> NtEnv
+mkNtEnv menv = 
+  foldl M.union M.empty $
+        map (\ (_,e) ->
+                 foldr (\ (_,thing) rest ->
+                            case thing of
+                              Kind _ -> rest
+                              Coercion d@(DefinedCoercion _ (lhs,_)) -> 
+                                  case splitTyConApp_maybe lhs of
+                                    Just ((_,tc1),_) -> M.insert tc1 d rest
+                                    _ -> rest) M.empty (etolist (tcenv_ e))) (etolist menv)