I have another question :) This one relates to Andrew Farmer's answer a while back on how to build dictionaries given a Concrete type. Everything I have works when I use my own numeric hierarchy, but when I use the Prelude's numeric hierarchy, GHC can't find the `Num Float` instance (or any other builtin instance).
I created the following function (based on HERMIT's buildDictionary function) to build my dictionaries (for GHC 7.10.1): -- | Given a function name and concrete type, get the needed dictionary. getDictConcrete :: ModGuts -> String -> Type -> CoreM (Maybe (Expr CoreBndr)) getDictConcrete guts opstr t = trace ("getDictConcrete "++opstr) $ do hscenv <- getHscEnv dflags <- getDynFlags eps <- liftIO $ hscEPS hscenv let (opname,ParentIs classname) = getNameParent guts opstr classType = mkTyConTy $ case lookupNameEnv (eps_PTE eps) classname of Just (ATyCon t) -> t Just (AnId _) -> error "loopupNameEnv AnId" Just (AConLike _) -> error "loopupNameEnv AConLike" Just (ACoAxiom _) -> error "loopupNameEnv ACoAxiom" Nothing -> error "getNameParent gutsEnv Nothing" dictType = mkAppTy classType t dictVar = mkGlobalVar VanillaId (mkSystemName (mkUnique 'z' 1337) (mkVarOcc $ "magicDictionaryName")) dictType vanillaIdInfo bnds <- runTcM guts $ do loc <- getCtLoc $ GivenOrigin UnkSkol let nonC = mkNonCanonical $ CtWanted { ctev_pred = dictType , ctev_evar = dictVar , ctev_loc = loc } wCs = mkSimpleWC [nonC] (x, evBinds) <- solveWantedsTcM wCs bnds <- initDsTc $ dsEvBinds evBinds liftIO $ do putStrLn $ "dictType="++showSDoc dflags (ppr dictType) putStrLn $ "dictVar="++showSDoc dflags (ppr dictVar) putStrLn $ "nonC="++showSDoc dflags (ppr nonC) putStrLn $ "wCs="++showSDoc dflags (ppr wCs) putStrLn $ "bnds="++showSDoc dflags (ppr bnds) putStrLn $ "x="++showSDoc dflags (ppr x) return bnds case bnds of [NonRec _ dict] -> return $ Just dict otherwise -> return Nothing When I use my own numeric class hierarchy, this works great! But when I use the Prelude numeric hierarchy, this doesn't work for some reason. In particular, if I pass `+` as the operation I want a dictionary for on the type `Float`, then the function returns `Nothing` with the following output: getDictConcrete + dictType=Num Float dictVar=magicDictionaryName_zlz nonC=[W] magicDictionaryName_zlz :: Num Float (CNonCanonical) wCs=WC {wc_simple = [W] magicDictionaryName_zlz :: Num Float (CNonCanonical)} bnds=[] x=WC {wc_simple = [W] magicDictionaryName_zlz :: Num Float (CNonCanonical)} If I change the `solveWantedTcMs` function to `simplifyInteractive`, then GHC panics with the following message: Top level: No instance for (GHC.Num.Num GHC.Types.Float) arising from UnkSkol Why doesn't the TcM monad know about the `Num Float` instance? On Fri, Sep 4, 2015 at 9:18 PM, Ömer Sinan Ağacan <omeraga...@gmail.com> wrote: > Typo: "You're parsing your code" I mean "You're passing your code" > > 2015-09-05 0:16 GMT-04:00 Ömer Sinan Ağacan <omeraga...@gmail.com>: >> Hi Mike, >> >> I'll try to hack an example for you some time tomorrow(I'm returning from >> ICFP >> and have some long flights ahead of me). >> >> But in the meantime, here's a working Core code, generated by GHC: >> >> f_rjH :: forall a_alz. Ord a_alz => a_alz -> Bool >> f_rjH = >> \ (@ a_aCH) ($dOrd_aCI :: Ord a_aCH) (eta_B1 :: a_aCH) -> >> == @ a_aCH (GHC.Classes.$p1Ord @ a_aCH $dOrd_aCI) eta_B1 eta_B1 >> >> You can clearly see here how Eq dictionary is selected from Ord >> dicitonary($dOrd_aCI in the example), it's just an application of selector to >> type and dictionary, that's all. >> >> This is generated from this code: >> >> {-# NOINLINE f #-} >> f :: Ord a => a -> Bool >> f x = x == x >> >> Compile it with this: >> >> ghc --make -fforce-recomp -O0 -ddump-simpl -ddump-to-file Main.hs >> -dsuppress-idinfo >> >>> Can anyone help me figure this out? Is there any chance this is a bug in >>> how >>> GHC parses Core? >> >> This seems unlikely, because GHC doesn't have a Core parser and there's no >> Core >> parsing going on here, you're parsing your Code in the form of AST(CoreExpr, >> CoreProgram etc. defined in CoreSyn.hs). Did you mean something else and am I >> misunderstanding? >> >> 2015-09-04 19:39 GMT-04:00 Mike Izbicki <m...@izbicki.me>: >>> I'm still having trouble creating Core code that can extract >>> superclass dictionaries from a given dictionary. I suspect the >>> problem is that I don't actually understand what the Core code to do >>> this is supposed to look like. I keep getting the errors mentioned >>> above when I try what I think should work. >>> >>> Can anyone help me figure this out? Is there any chance this is a bug >>> in how GHC parses Core? >>> >>> On Tue, Aug 25, 2015 at 9:24 PM, Mike Izbicki <m...@izbicki.me> wrote: >>>> The purpose of the plugin is to automatically improve the numerical >>>> stability of Haskell code. It is supposed to identify numeric >>>> expressions, then use Herbie (https://github.com/uwplse/herbie) to >>>> generate a numerically stable version, then rewrite the numerically >>>> stable version back into the code. The first two steps were really >>>> easy. It's the last step of inserting back into the code that I'm >>>> having tons of trouble with. Core is a lot more complicated than I >>>> thought :) >>>> >>>> I'm not sure what you mean by the CoreExpr representation? Here's the >>>> output of the pretty printer you gave: >>>> App (App (App (App (Var Id{+,r2T,ForAllTy TyVar{a} (FunTy (TyConApp >>>> Num [TyVarTy TyVar{a}]) (FunTy (TyVarTy TyVar{a}) (FunTy (TyVarTy >>>> TyVar{a}) (TyVarTy TyVar{a})))),VanillaId,Info{0,SpecInfo [] >>>> <UniqFM>,NoUnfolding,MayHaveCafRefs,NoOneShotInfo,InlinePragma >>>> {inl_src = "{-# INLINE", inl_inline = EmptyInlineSpec, inl_sat = >>>> Nothing, inl_act = AlwaysActive, inl_rule = >>>> FunLike},NoOccInfo,StrictSig (DmdType <UniqFM> [] (Dunno NoCPR)),JD >>>> {strd = Lazy, absd = Use Many Used},0}}) (Type (TyVarTy TyVar{a}))) >>>> (App (Var Id{$p1Fractional,rh3,ForAllTy TyVar{a} (FunTy (TyConApp >>>> Fractional [TyVarTy TyVar{a}]) (TyConApp Num [TyVarTy >>>> TyVar{a}])),ClassOpId <Class>,Info{1,SpecInfo [BuiltinRule {ru_name = >>>> "Class op $p1Fractional", ru_fn = $p1Fractional, ru_nargs = 2, ru_try >>>> = <RuleFun>}] <UniqFM>,NoUnfolding,NoCafRefs,NoOneShotInfo,InlinePragma >>>> {inl_src = "{-# INLINE", inl_inline = EmptyInlineSpec, inl_sat = >>>> Nothing, inl_act = AlwaysActive, inl_rule = >>>> FunLike},NoOccInfo,StrictSig (DmdType <UniqFM> [JD {strd = Str (SProd >>>> [Str HeadStr,Lazy,Lazy,Lazy]), absd = Use Many (UProd [Use Many >>>> Used,Abs,Abs,Abs])}] (Dunno NoCPR)),JD {strd = Lazy, absd = Use Many >>>> Used},0}}) (App (Var Id{$p1Floating,rh2,ForAllTy TyVar{a} (FunTy >>>> (TyConApp Floating [TyVarTy TyVar{a}]) (TyConApp Fractional [TyVarTy >>>> TyVar{a}])),ClassOpId <Class>,Info{1,SpecInfo [BuiltinRule {ru_name = >>>> "Class op $p1Floating", ru_fn = $p1Floating, ru_nargs = 2, ru_try = >>>> <RuleFun>}] <UniqFM>,NoUnfolding,NoCafRefs,NoOneShotInfo,InlinePragma >>>> {inl_src = "{-# INLINE", inl_inline = EmptyInlineSpec, inl_sat = >>>> Nothing, inl_act = AlwaysActive, inl_rule = >>>> FunLike},NoOccInfo,StrictSig (DmdType <UniqFM> [JD {strd = Str (SProd >>>> [Str >>>> HeadStr,Lazy,Lazy,Lazy,Lazy,Lazy,Lazy,Lazy,Lazy,Lazy,Lazy,Lazy,Lazy,Lazy,Lazy,Lazy,Lazy,Lazy,Lazy]), >>>> absd = Use Many (UProd [Use Many >>>> Used,Abs,Abs,Abs,Abs,Abs,Abs,Abs,Abs,Abs,Abs,Abs,Abs,Abs,Abs,Abs,Abs,Abs,Abs])}] >>>> (Dunno NoCPR)),JD {strd = Lazy, absd = Use Many Used},0}}) (Var >>>> Id{$dFloating,aBM,TyConApp Floating [TyVarTy >>>> TyVar{a}],VanillaId,Info{0,SpecInfo [] >>>> <UniqFM>,NoUnfolding,MayHaveCafRefs,NoOneShotInfo,InlinePragma >>>> {inl_src = "{-# INLINE", inl_inline = EmptyInlineSpec, inl_sat = >>>> Nothing, inl_act = AlwaysActive, inl_rule = >>>> FunLike},NoOccInfo,StrictSig (DmdType <UniqFM> [] (Dunno NoCPR)),JD >>>> {strd = Lazy, absd = Use Many Used},0}})))) (Var Id{x1,anU,TyVarTy >>>> TyVar{a},VanillaId,Info{0,SpecInfo [] >>>> <UniqFM>,NoUnfolding,MayHaveCafRefs,NoOneShotInfo,InlinePragma >>>> {inl_src = "{-# INLINE", inl_inline = EmptyInlineSpec, inl_sat = >>>> Nothing, inl_act = AlwaysActive, inl_rule = >>>> FunLike},NoOccInfo,StrictSig (DmdType <UniqFM> [] (Dunno NoCPR)),JD >>>> {strd = Lazy, absd = Use Many Used},0}})) (Var Id{x1,anU,TyVarTy >>>> TyVar{a},VanillaId,Info{0,SpecInfo [] >>>> <UniqFM>,NoUnfolding,MayHaveCafRefs,NoOneShotInfo,InlinePragma >>>> {inl_src = "{-# INLINE", inl_inline = EmptyInlineSpec, inl_sat = >>>> Nothing, inl_act = AlwaysActive, inl_rule = >>>> FunLike},NoOccInfo,StrictSig (DmdType <UniqFM> [] (Dunno NoCPR)),JD >>>> {strd = Lazy, absd = Use Many Used},0}}) >>>> >>>> You can find my pretty printer (and all the other code for the plugin) >>>> at: >>>> https://github.com/mikeizbicki/herbie-haskell/blob/master/src/Herbie.hs#L627 >>>> >>>> The function getDictMap >>>> (https://github.com/mikeizbicki/herbie-haskell/blob/master/src/Herbie.hs#L171) >>>> is where I'm constructing the dictionaries that are getting inserted >>>> back into the Core. >>>> >>>> On Tue, Aug 25, 2015 at 7:17 PM, Ömer Sinan Ağacan <omeraga...@gmail.com> >>>> wrote: >>>>> It seems like in your App syntax you're having a non-function in function >>>>> position. You can see this by looking at what failing function >>>>> (splitFunTy_maybe) is doing: >>>>> >>>>> splitFunTy_maybe :: Type -> Maybe (Type, Type) >>>>> -- ^ Attempts to extract the argument and result types from a type >>>>> ... (definition is not important) ... >>>>> >>>>> Then it's used like this at the error site: >>>>> >>>>> (arg_ty, res_ty) = expectJust "cpeBody:collect_args" $ >>>>> splitFunTy_maybe fun_ty >>>>> >>>>> In your case this function is returning Nothing and then exceptJust is >>>>> signalling the panic. >>>>> >>>>> Your code looked correct to me, I don't see any problems with that. Maybe >>>>> you're >>>>> using something wrong as selectors. Could you paste CoreExpr >>>>> representation of >>>>> your program? >>>>> >>>>> It may also be the case that the panic is caused by something else, maybe >>>>> your >>>>> syntax is invalidating some assumptions/invariants in GHC but it's not >>>>> immediately checked etc. Working at the Core level is frustrating at >>>>> times. >>>>> >>>>> Can I ask what kind of plugin are you working on? >>>>> >>>>> (Btw, how did you generate this representation of AST? Did you write it >>>>> manually? If you have a pretty-printer, would you mind sharing it?) >>>>> >>>>> 2015-08-25 18:50 GMT-04:00 Mike Izbicki <m...@izbicki.me>: >>>>>> Thanks Ömer! >>>>>> >>>>>> I'm able to get dictionaries for the superclasses of a class now, but >>>>>> I get an error whenever I try to get a dictionary for a >>>>>> super-superclass. Here's the Haskell expression I'm working with: >>>>>> >>>>>> test1 :: Floating a => a -> a >>>>>> test1 x1 = x1+x1 >>>>>> >>>>>> The original core is: >>>>>> >>>>>> + @ a $dNum_aJu x1 x1 >>>>>> >>>>>> But my plugin is replacing it with the core: >>>>>> >>>>>> + @ a ($p1Fractional ($p1Floating $dFloating_aJq)) x1 x1 >>>>>> >>>>>> The only difference is the way I'm getting the Num dictionary. The >>>>>> corresponding AST (annotated with variable names and types) is: >>>>>> >>>>>> App >>>>>> (App >>>>>> (App >>>>>> (App >>>>>> (Var +::forall a. Num a => a -> a -> a) >>>>>> (Type a) >>>>>> ) >>>>>> (App >>>>>> (Var $p1Fractional::forall a. Fractional a => Num a) >>>>>> (App >>>>>> (Var $p1Floating::forall a. Floating a => Fractional >>>>>> a) >>>>>> (Var $dFloating_aJq::Floating a) >>>>>> ) >>>>>> ) >>>>>> ) >>>>>> (Var x1::'a') >>>>>> ) >>>>>> (Var x1::'a') >>>>>> >>>>>> When I insert, GHC gives the following error: >>>>>> >>>>>> ghc: panic! (the 'impossible' happened) >>>>>> (GHC version 7.10.1 for x86_64-unknown-linux): >>>>>> expectJust cpeBody:collect_args >>>>>> >>>>>> What am I doing wrong with extracting these super-superclass >>>>>> dictionaries? I've looked up the code for cpeBody in GHC, but I can't >>>>>> figure out what it's trying to do, so I'm not sure why it's failing on >>>>>> my core. >>>>>> >>>>>> On Mon, Aug 24, 2015 at 7:10 PM, Ömer Sinan Ağacan >>>>>> <omeraga...@gmail.com> wrote: >>>>>>> Mike, here's a piece of code that may be helpful to you: >>>>>>> >>>>>>> https://github.com/osa1/sc-plugin/blob/master/src/Supercompilation/Show.hs >>>>>>> >>>>>>> Copy this module to your plugin, it doesn't have any dependencies other >>>>>>> than >>>>>>> ghc itself. When your plugin is initialized, update `dynFlags_ref` with >>>>>>> your >>>>>>> DynFlags as first thing to do. Then use Show instance to print AST >>>>>>> directly. >>>>>>> >>>>>>> Horrible hack, but very useful for learning purposes. In fact, I don't >>>>>>> know how >>>>>>> else we can learn what Core is generated for a given code, and >>>>>>> reverse-engineer >>>>>>> to figure out details. >>>>>>> >>>>>>> Hope it helps. >>>>>>> >>>>>>> 2015-08-24 21:59 GMT-04:00 Ömer Sinan Ağacan <omeraga...@gmail.com>: >>>>>>>>> Lets say I'm running the plugin on a function with signature >>>>>>>>> `Floating a => a >>>>>>>>> -> a`, then the plugin has access to the `Floating` dictionary for >>>>>>>>> the type. >>>>>>>>> But if I want to add two numbers together, I need the `Num` >>>>>>>>> dictionary. I >>>>>>>>> know I should have access to `Num` since it's a superclass of >>>>>>>>> `Floating`. >>>>>>>>> How can I get access to these superclass dictionaries? >>>>>>>> >>>>>>>> I don't have a working code for this but this should get you started: >>>>>>>> >>>>>>>> let ord_dictionary :: Id = ... >>>>>>>> ord_class :: Class = ... >>>>>>>> in >>>>>>>> mkApps (Var (head (classSCSels ord_class))) [Var >>>>>>>> ord_dictionary] >>>>>>>> >>>>>>>> I don't know how to get Class for Ord. I do `head` here because in the >>>>>>>> case of >>>>>>>> Ord we only have one superclass so `classSCSels` should have one Id. >>>>>>>> Then I >>>>>>>> apply ord_dictionary to this selector and it should return dictionary >>>>>>>> for Eq. >>>>>>>> >>>>>>>> I assumed you already have ord_dictionary, it should be passed to your >>>>>>>> function >>>>>>>> already if you had `(Ord a) => ` in your function. >>>>>>>> >>>>>>>> >>>>>>>> Now I realized you asked for getting Num from Floating. I think you >>>>>>>> should >>>>>>>> follow a similar path except you need two applications, first to get >>>>>>>> Fractional >>>>>>>> from Floating and second to get Num from Fractional: >>>>>>>> >>>>>>>> mkApps (Var (head (classSCSels fractional_class))) >>>>>>>> [mkApps (Var (head (classSCSels floating_class))) >>>>>>>> [Var floating_dictionary]] >>>>>>>> >>>>>>>> Return value should be a Num dictionary. >>> _______________________________________________ >>> ghc-devs mailing list >>> ghc-devs@haskell.org >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs _______________________________________________ ghc-devs mailing list ghc-devs@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs