question about GHC API on GHC plugin
Mike Izbicki
mike at izbicki.me
Tue Sep 22 15:11:58 UTC 2015
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 <mike at izbicki.me> 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 <omeragacan at 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 <omeragacan at 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 <mike at 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 <mike at 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 <omeragacan at 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 <mike at 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 <omeragacan at 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 <omeragacan at 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 at haskell.org
>>>> http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs
More information about the ghc-devs
mailing list