Thanks for the e-mail. I might just be very confused about how instance definitions are stored, but what is the difference between the type variables stored with a specific instance (that one can get with is_tvs) and the type variables stored with the class?
Also, the error messages seem to be coming from trying to do this for type class instances that involve type variables in some context. (For example, (Show a, Show b, Show c) => Show ((,,) a b c).) Any suggestions about what to watch out for when dealing with these? Thanks, Jean On Wed, Apr 29, 2009 at 11:44 AM, Simon Peyton-Jones <[email protected]>wrote: > 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]> 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. > *^^` > -- 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
