more stuff with the things

7 files changed, 32 insertions, 11 deletions

diff --git a/compiler/basicTypes/Id.hs b/compiler/basicTypes/Id.hs
index d29a25cc02..a48a0b3945 100644
--- a/compiler/basicTypes/Id.hs
+++ b/compiler/basicTypes/Id.hs
@@ -35,6 +35,7 @@ module Id (
         -- ** Simple construction
         mkGlobalId, mkVanillaGlobal, mkVanillaGlobalWithInfo,
         mkLocalId, mkLocalCoVar, mkLocalIdOrCoVar,
+        mkLocalIdOrCoVarWithInfo,
         mkLocalIdWithInfo, mkExportedLocalId, mkExportedVanillaId,
         mkSysLocal, mkSysLocalM, mkSysLocalOrCoVar, mkSysLocalOrCoVarM,
         mkUserLocal, mkUserLocalOrCoVar,
@@ -268,6 +269,14 @@ mkLocalId :: HasDebugCallStack => Name -> Type -> Id
 mkLocalId name ty = ASSERT( not (isCoVarType ty) )
                     mkLocalIdWithInfo name ty vanillaIdInfo
 
+
+
+    -- proper ids only; no covars!
+mkLocalIdWithInfo :: HasDebugCallStack => Name -> Type -> IdInfo -> Id
+mkLocalIdWithInfo name ty info = ASSERT( not (isCoVarType ty) )
+                                 Var.mkLocalVar VanillaId name ty info
+        -- Note [Free type variables]
+
 -- | Make a local CoVar
 mkLocalCoVar :: Name -> Type -> CoVar
 mkLocalCoVar name ty
@@ -280,11 +289,14 @@ mkLocalIdOrCoVar name ty
   | isCoVarType ty = mkLocalCoVar name ty
   | otherwise      = mkLocalId    name ty
 
-    -- proper ids only; no covars!
-mkLocalIdWithInfo :: HasDebugCallStack => Name -> Type -> IdInfo -> Id
-mkLocalIdWithInfo name ty info = ASSERT( not (isCoVarType ty) )
-                                 Var.mkLocalVar VanillaId name ty info
-        -- Note [Free type variables]
+-- | Make a local id, with the IdDetails set to CoVarId if the type indicates
+-- so.
+mkLocalIdOrCoVarWithInfo :: Name -> Type -> IdInfo -> Id
+mkLocalIdOrCoVarWithInfo name ty info
+  = Var.mkLocalVar details name ty info
+  where
+    details | isCoVarType ty = CoVarId
+            | otherwise      = VanillaId
 
 -- | Create a local 'Id' that is marked as exported.
 -- This prevents things attached to it from being removed as dead code.
diff --git a/compiler/basicTypes/IdInfo.hs b/compiler/basicTypes/IdInfo.hs
index aee8a8b6d6..5cb124b4c5 100644
--- a/compiler/basicTypes/IdInfo.hs
+++ b/compiler/basicTypes/IdInfo.hs
@@ -217,8 +217,9 @@ pprIdDetails other     = brackets (pp other)
                               = brackets $ text "RecSel" <>
                                            ppWhen is_naughty (text "(naughty)")
    pp CoVarId                 = text "CoVarId"
+   pp CoercionHoleId          = text "CoercionHoleId"
    pp (JoinId arity)          = text "JoinId" <> parens (int arity)
-
+-- fixmeee
 {-
 ************************************************************************
 *                                                                      *
diff --git a/compiler/coreSyn/CoreFVs.hs b/compiler/coreSyn/CoreFVs.hs
index d2fc1606db..14dee31144 100644
--- a/compiler/coreSyn/CoreFVs.hs
+++ b/compiler/coreSyn/CoreFVs.hs
@@ -372,7 +372,7 @@ orphNamesOfMCo MRefl    = emptyNameSet
 orphNamesOfMCo (MCo co) = orphNamesOfCo co
 
 orphNamesOfCo :: Coercion -> NameSet
-orphNamesOfCo (ErasedCoercion vs  _r lty rty )
+orphNamesOfCo (ErasedCoercion _vs  _r lty rty )
                                     = orphNamesOfType lty `unionNameSet`  orphNamesOfType rty
 orphNamesOfCo (Refl ty)             = orphNamesOfType ty
 orphNamesOfCo (GRefl _ ty mco)      = orphNamesOfType ty `unionNameSet` orphNamesOfMCo mco
diff --git a/compiler/iface/ToIface.hs b/compiler/iface/ToIface.hs
index 8aabfc01c1..252e4d38c3 100644
--- a/compiler/iface/ToIface.hs
+++ b/compiler/iface/ToIface.hs
@@ -274,7 +274,9 @@ toIfaceCoercionX fr co
                               | isOpen v  = (a, b, v:c)
                               | isCoVar v = (a, toIfaceCoVar v:b, c)
                               | isTyVar v = (toIfaceTyVar v:a, b, c)
-                              | otherwise = panic "ToIface.toIfaceCoercionX(go_prov): Bad free variable in ZappedProv"
+                              |otherwise = (a,b,c)
+              --  -   | otherwise = panic "ToIface.toIfaceCoercionX(go): Bad free variable in ErasedCoercion"
+              --    TODO FIX ME all the upstream filtering
 
     go (Refl ty)            = IfaceReflCo (toIfaceTypeX fr ty)
     go (GRefl r ty mco)     = IfaceGReflCo r (toIfaceTypeX fr ty) (go_mco mco)
diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs
index 72a0815af1..bfee5fdd2c 100644
--- a/compiler/typecheck/TcMType.hs
+++ b/compiler/typecheck/TcMType.hs
@@ -109,6 +109,7 @@ import TcRnMonad        -- TcType, amongst others
 import Constraint
 import TcEvidence
 import Id
+import IdInfo (IdDetails(CoercionHoleId))
 import Name
 import VarSet
 import TysWiredIn
@@ -319,6 +320,11 @@ newImplication
 ************************************************************************
 -}
 
+newCoHoleVar :: TcPredType -> TcRnIf gbl lbl CoVar
+newCoHoleVar ty = do { var <- newEvVar ty
+                     ; return $ setIdDetails var CoercionHoleId
+                     }
+
 newCoercionHole :: TcPredType -> TcM CoercionHole
 newCoercionHole pred_ty
   = do { co_var <- newEvVar pred_ty
diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs
index f2eb296002..1f366aee66 100644
--- a/compiler/types/Coercion.hs
+++ b/compiler/types/Coercion.hs
@@ -1322,7 +1322,7 @@ mkKindCo co | Just (ty, _) <- isReflCo_maybe co = Refl (typeKind ty)
 mkKindCo (GRefl _ _ (MCo co)) = co
 mkKindCo (UnivCo (PhantomProv h) _ _ _)    = h
 mkKindCo (UnivCo (ProofIrrelProv h) _ _ _) = h
-mkKindCo (ErasedCoercion fvs r lt rt )
+mkKindCo (ErasedCoercion fvs _r lt rt )
         = (ErasedCoercion fvs Nominal (typeKind lt) (typeKind rt))
 mkKindCo co
   | Pair ty1 ty2 <- coercionKind co
@@ -2419,7 +2419,7 @@ coercionRKind co
     go (InstCo aco arg)         = go_app aco [go arg]
     go (KindCo co)              = typeKind (go co)
     go (SubCo co)               = go co
-    go (NthCo _ d co)           = go_nth d (go co)
+    go (NthCo _ d co)           = go_nth d (go co) -- something wrong here ;)
     go (AxiomInstCo ax ind cos) = go_ax_inst ax ind (map go cos)
     go (AxiomRuleCo ax cos)     = pSnd $ expectJust "coercionKind" $
                                   coaxrProves ax $ map coercionKind cos
diff --git a/compiler/types/TyCoFVs.hs b/compiler/types/TyCoFVs.hs
index 56d430ef1d..9c347ab7d4 100644
--- a/compiler/types/TyCoFVs.hs
+++ b/compiler/types/TyCoFVs.hs
@@ -739,7 +739,7 @@ noFreeVarsOfTypes = all noFreeVarsOfType
 -- | Returns True if this coercion has no free variables. Should be the same as
 -- isEmptyVarSet . tyCoVarsOfCo, but faster in the non-forall case.
 noFreeVarsOfCo :: Coercion -> Bool
-noFreeVarsOfCo (ErasedCoercion fvs r lty rty)=  noFreeVarsOfType lty &&
+noFreeVarsOfCo (ErasedCoercion fvs _r lty rty)=  noFreeVarsOfType lty &&
                                             noFreeVarsOfType rty && isEmptyDVarSet fvs
 noFreeVarsOfCo (Refl ty)              = noFreeVarsOfType ty
 noFreeVarsOfCo (GRefl _ ty co)        = noFreeVarsOfType ty && noFreeVarsOfMCo co