I have only the vaguest idea what you are doing, so it's hard to be helpful. It seems that by calling is_tys you are extracting a type that will mention type variables that certainly won't be in scope. Maybe that has something to do with it.
I'd us traceTc to print lots of debug output, so that you can narrow down just what is emitting the error you are seeing. S From: [email protected] [mailto:[email protected]] On Behalf Of Jean Yang Sent: 29 April 2009 16:16 To: Jean Yang; [email protected] Subject: Re: Question about typechecker renaming of tyvars Hi Ian and all, My change is mostly confined to TcSplice.lhs, where I have a function that gets the instance information given the name of a type class. When I call it with names of type classes defined in source code I'm currently compiling, it works fine. When I call it with names of type classes defined with linked code, I get the type variable not in scope problem. (As I said in my original e-mail I think this might be coming from some renaming phase somewhere?) I've included the function I added (which is n compiler/typecheck/TcSplice.lhs) below. Thanks, Jean instances :: TH.Name -> TcM [[(String, TH.Info)]] instances th_name = do -- First get class information. name <- lookupThName th_name classThing <- tcLookupTh name let (classTvars, classMethodNames, classMethodSigs) = getMethodInfo classThing -- Now get instance information. elts <- lookupInsts $ getTyThing classThing {- instEnv <- getInstEnv $ getTyThing classThing let elts = instEnvElts instEnv -} -- instTys :: [[Type]] let instTys = map is_tys $ filter matches elts instantiatedClassMethods <- mapM (instantiate classTvars classMethodSigs classMethodNames) instTys return instantiatedClassMethods where getTyThing :: TcTyThing -> TyThing getTyThing thing = case thing of AGlobal tything -> tything ATcId _id _co _type _level -> panic "Type ID is not a class." ATyVar _name _type -> panic "Type var is not a class." AThing _kind -> panic "Thing is not a class" getMethodInfo :: TcTyThing -> ([TyVar], [Name], [Type]) getMethodInfo thing = case (getTyThing thing) of AnId _id -> panic "Not a class." ADataCon _con -> panic "Not a class." ATyCon _tycon -> panic "Not a class." AClass c -> processClass c where processClass c = let tyvars = classTyVars c methodIds = classSelIds c in (tyvars, map getName methodIds, map processMethodId methodIds) processMethodId id = if isId id then varType id else panic "Expected id" getInstanceName :: Instance -> String getInstanceName = occNameString . nameOccName . is_cls matches inst = getInstanceName inst == (TH.occString (get_name th_name)) get_name (TH.Name occ _) = occ instantiate :: [TyVar] -- ^ Type variables -> [Type] -- ^ Class signatures -> [Name] -> [Type] -- ^ Instance args -> TcM [(String, TH.Info)] instantiate tyvars classSigs methodNames instArgs = do mapM instMethods (zip classSigs methodNames) where tymap = zip tyvars instArgs getTy tvar = case lookup tvar tymap of Just ty -> case ty of TyVarTy _ -> panic "cannot insert another var" _ -> ty Nothing -> panic "cannot find tyvar" instMethods :: (Type, Name) -> TcM (String, TH.Info) instMethods (ty, name) = do let nameStr = (occNameString . nameOccName) name let name' = reifyName name ty' <- reifyType $ inst' ty return $ (nameStr, TH.VarI name' ty' Nothing TH.defaultFixity) inst' :: Type -> Type inst' ty = case ty of TyVarTy tvar -> getTy tvar AppTy t1 t2 -> AppTy (inst' t1) (inst' t2) TyConApp tcon tys -> TyConApp tcon $ map inst' tys FunTy t1 t2 -> if isPredTy t1 then inst' t2 else FunTy (inst' t1) (inst' t2) ForAllTy tyvar ty -> if elem tyvar tyvars then inst' ty else ForAllTy tyvar (inst' ty) PredTy pr -> PredTy (case pr of ClassP cl tys -> ClassP cl (map inst' tys) IParam ipn ty -> IParam ipn ty EqPred t1 t2 -> EqPred (inst' t1) (inst' t2)) On Fri, Mar 6, 2009 at 11:37 AM, Ian Lynagh <[email protected]<mailto:[email protected]>> wrote: Hi Jean, On Thu, Feb 19, 2009 at 09:41:37AM -0500, Jean Yang wrote: > > I've been trying to extend the Template Haskell parts of GHC (mostly > compiler/typechek/TcSplice.lhs) so that I can get back the signatures of > methods for all instances of a given type class. I get unbound type > variable errors (ex. Main.hs:21:9: Not in scope: type variable `l[i19B]') at > compile time when I am accessing type classes not defined in my source code > (ex. Show). > > Could this be caused by some renaming stage? If so, could someone point > me to where this occurs? > > Also, is this the right place for such questions? This is the right place, but I'm afraid I don't know what the problem is. If you show us your patch then perhaps we will be able to work out what's going on. Thanks Ian -- Jean Yang http://web.mit.edu/jeanyang/www/ Save us! Think before you print. *^^`
_______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
