question about GHC API on GHC plugin
Mike Izbicki
mike at izbicki.me
Mon Sep 7 20:26:53 UTC 2015
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