Thanks to everyone who helped me on this project! I've released the final result on github at https://github.com/mikeizbicki/HerbiePlugin#herbie-ghc-plugin
On Mon, Sep 7, 2015 at 1:26 PM, Mike Izbicki <[email protected]> wrote: > 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 <[email protected]> > 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 <[email protected]>: >>> 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 <[email protected]>: >>>> 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 <[email protected]> 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 <[email protected]> >>>>> 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 <[email protected]>: >>>>>>> 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 >>>>>>> <[email protected]> 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 <[email protected]>: >>>>>>>>>> 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 >>>> [email protected] >>>> http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs _______________________________________________ ghc-devs mailing list [email protected] http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs
