- Simple generation of a type refinement
-%* *
-%************************************************************************
-
-\begin{code}
-matchRefine :: [CoVar] -> Refinement
-\end{code}
-
-Given a list of coercions, where for each coercion c::(ty1~ty2), the type ty2
-is a specialisation of ty1, produce a type refinement that maps the variables
-of ty1 to the corresponding sub-terms of ty2 using appropriate coercions; eg,
-
- matchRefine (co :: [(a, b)] ~ [(c, Maybe d)])
- = { right (left (right co)) :: a ~ c
- , right (right co) :: b ~ Maybe d
- }
-
-Precondition: The rhs types must indeed be a specialisation of the lhs types;
- i.e., some free variables of the lhs are replaced with either distinct free
- variables or proper type terms to obtain the rhs. (We don't perform full
- unification or type matching here!)
-
-NB: matchRefine does *not* expand the type synonyms.
-
-\begin{code}
-matchRefine co_vars
- = Reft in_scope (foldr plusVarEnv emptyVarEnv (map refineOne co_vars))
- where
- in_scope = foldr extend emptyInScopeSet co_vars
-
- -- For each co_var, add it *and* the tyvars it mentions, to in_scope
- extend co_var in_scope
- = extendInScopeSetSet in_scope $
- extendVarSet (tyVarsOfType (tyVarKind co_var)) co_var
-
- refineOne co_var = refine (TyVarTy co_var) ty1 ty2
- where
- (ty1, ty2) = splitCoercionKind (tyVarKind co_var)
-
- refine co (TyVarTy tv) ty = unitVarEnv tv (co, ty)
- refine co (TyConApp _ tys) (TyConApp _ tys') = refineArgs co tys tys'
- refine _ (PredTy _) (PredTy _) =
- error "Unify.matchRefine: PredTy"
- refine co (FunTy arg res) (FunTy arg' res') =
- refine (mkRightCoercion (mkLeftCoercion co)) arg arg'
- `plusVarEnv`
- refine (mkRightCoercion co) res res'
- refine co (AppTy fun arg) (AppTy fun' arg') =
- refine (mkLeftCoercion co) fun fun'
- `plusVarEnv`
- refine (mkRightCoercion co) arg arg'
- refine co (ForAllTy tv ty) (ForAllTy _tv ty') =
- refine (mkForAllCoercion tv co) ty ty' `delVarEnv` tv
- refine _ _ _ = error "RcGadt.matchRefine: mismatch"
-
- refineArgs :: Coercion -> [Type] -> [Type] -> InternalReft
- refineArgs co tys tys' =
- fst $ foldr refineArg (emptyVarEnv, id) (zip tys tys')
- where
- refineArg (ty, ty') (reft, coWrapper)
- = (refine (mkRightCoercion (coWrapper co)) ty ty' `plusVarEnv` reft,
- mkLeftCoercion . coWrapper)
-\end{code}
-
-
-%************************************************************************
-%* *
- Unification
-%* *