let scope = filter (isValidType .idType ) scope'
mod_name = moduleNameFS$ moduleName mod
if null scope && instrumenting
- then return (l$ HsVar lazyId)
+ -- need to return some expresion, hence lazy is used here as a noop (hopefully)
+ then return (l$ HsVar lazyId)
else do
when (not instrumenting) $
warnDs (text "Extracted ids:" <+> (ppr scope $$
-- TODO: Improve the offset handling in decode (make it machine dependant)
-----------------------------------
--- Boilerplate Fold code for Term
+-- * Traversals for Terms
-----------------------------------
data TermFold a = TermFold { fTerm :: Type -> DataCon -> HValue -> [a] -> a
-- in the right side reptypes for newtypes as found in the lhs
-- Sadly it doesn't cover all the possibilities. It does not always manage
-- to recover the highest level type. See test print016 for an example
+-- This is used for approximating a unification over types modulo newtypes that recovers
+-- the most concrete, with-newtypes type
congruenceNewtypes :: TcType -> TcType -> TcM TcType
congruenceNewtypes lhs rhs
-- | pprTrace "Congruence" (ppr lhs $$ ppr rhs) False = undefined
}
tidy ty = tidyType (emptyTidyOccEnv, tidyVarEnv ty) ty
tidyVarEnv ty =
+
mkVarEnv$ [ (v, setTyVarName v (tyVarName tv))
| (tv,v) <- zip alphaTyVars vars]
where vars = varSetElems$ tyVarsOfType ty
subTerms = reOrderTerms subTermsP subTermsNP subTtypes
resType <- liftM mkTyVarTy (newVar k)
baseType <- instScheme (dataConRepType dc)
- let myType = mkFunTys (map (fromMaybe undefined . termType)
+ let myType = mkFunTys (map (fromMaybe (error "cvObtainTerm1") . termType)
subTerms)
resType
addConstraint baseType myType