Finding out if a binding is externally visible
Sebastian Graf
sgraf1337 at gmail.com
Mon May 29 08:40:44 UTC 2017
OK, I attached an example for a specialization of Show for a special case
of a custom type, like Ratio in GHC.Real
<https://hackage.haskell.org/package/base-4.9.1.0/docs/src/GHC.Real.html>.
My invokation with a custom GHC (8.0-based) was like this:
$ <ghc> Module.hs -ddump-simpl -O -fforce-recomp
At the begin of the log, I listed all exported top-level identifiers, the
only interesting of which is `$fShowRatio :: Show a => Show (Ratio a)`, the
default implementation. Note that at the bottom, there are RULEs stating
the specialization for `Show Integer`, but that the specialized dictionary
`$fShowRatio_$s$fShowRatio :: Show (Ratio Integer)` isn't otherwise
reachable from any exported top-level identifier. Same goes for any of the
specialized dictionary methods.
Now consider what happens if we request a `Show (Ratio Integer)` dictionary
in another module: GHC finds the exported default dictionary `$fShowRatio
:: Show a => Show (Ratio a)`, but then applies a specialization RULE that
will effectively use the presumably absent `$fShowRatio_$s$fShowRatio ::
Show (Ratio Integer)`.
In my case, my custom GHC would substitute away the `showString " % "` for
an `absentError "lvl [Char]"` and crash in subtle ways. The only reason
this isn't happening for GHC master is that DmdAnal does consider all
top-level arguments to be used, instead of only the exported ones (which is
what CallArity does).
On Sun, May 28, 2017 at 11:53 PM, Sebastian Graf <sgraf1337 at gmail.com>
wrote:
>
> welcome on this list!
>
>
> Thanks :)
>
> isExportedId :: Var -> Bool
>
>
> That's what I have been using so far, but I found that said RULE pragmas
> mentioned non-exported identifiers. Or maybe it was just some temporary
> build system mess-up, I'll work on a reproduction...
>
> On Sun, May 28, 2017 at 10:33 PM, Joachim Breitner <
> mail at joachim-breitner.de> wrote:
>
>> Hi Sebastian,
>>
>> welcome on this list!
>>
>> Am Sonntag, den 28.05.2017, 17:52 +0200 schrieb Sebastian Graf:
>> > Is there some function that tells me if an identifier is 'externally
>> > visible' in that sense? I think https://downloads.haskell.org/~ghc/8.
>> > 0.1/docs/html/libraries/ghc-8.0.1/GHC.html#v:isExternalName is what
>> > I'm after, but I want to be sure. Does that function already work
>> > when the Ids are still local?
>>
>> I would expect
>>
>> isExportedId :: Var -> Bool
>>
>> to do precisely that.
>>
>> Greetings,
>> Joachim
>>
>> --
>> Joachim “nomeata” Breitner
>> mail at joachim-breitner.de • https://www.joachim-breitner.de/
>> XMPP: nomeata at joachim-breitner.de • OpenPGP-Key: 0xF0FBF51F
>> Debian Developer: nomeata at debian.org
>> _______________________________________________
>> ghc-devs mailing list
>> ghc-devs at haskell.org
>> http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs
>>
>>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-devs/attachments/20170529/e0dd016a/attachment-0001.html>
-------------- next part --------------
exported ids:
[r7 :-> $tcRatio, ra :-> $trModule, rc :-> $tc'MkRatio,
rt :-> $fShowRatio]
[1 of 1] Compiling Module ( Module.hs, Module.o )
==================== Tidy Core ====================
Result size of Tidy Core = {terms: 195, types: 233, coercions: 0}
-- RHS size: {terms: 2, types: 3, coercions: 0}
Module.$fShowRatio1 :: [Char]
[GblId, Str=x]
Module.$fShowRatio1 =
Control.Exception.Base.absentError
@ 'GHC.Types.PtrRepLifted @ [Char] "lvl [Char]"#
-- RHS size: {terms: 17, types: 14, coercions: 0}
Module.$w$s$cshowsPrec [InlPrag=[0]]
:: Integer -> Integer -> String -> (# Char, [Char] #)
[GblId,
Arity=3,
Str=<S,U><L,U><L,U>,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [0 0 0] 130 0}]
Module.$w$s$cshowsPrec =
\ (ww_s15t :: Integer) (ww1_s15u :: Integer) (w_s15q :: String) ->
GHC.Show.$w$cshowsPrec1
0#
ww_s15t
(++
@ Char
Module.$fShowRatio1
(case GHC.Show.$w$cshowsPrec1 0# ww1_s15u w_s15q of
{ (# ww3_a12Z, ww4_a130 #) ->
GHC.Types.: @ Char ww3_a12Z ww4_a130
}))
-- RHS size: {terms: 15, types: 18, coercions: 0}
Module.$fShowRatio_$s$cshowsPrec [InlPrag=INLINE[0]]
:: Int -> Ratio Integer -> ShowS
[GblId,
Arity=3,
Str=<L,A><S(SL),1*U(U,U)><L,U>m2,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=False)
Tmpl= \ _ [Occ=Dead]
(w1_s15p [Occ=Once!] :: Ratio Integer)
(w2_s15q [Occ=Once] :: String) ->
case w1_s15p of
{ MkRatio ww1_s15t [Occ=Once] ww2_s15u [Occ=Once] ->
case Module.$w$s$cshowsPrec ww1_s15t ww2_s15u w2_s15q of
{ (# ww4_s15T [Occ=Once], ww5_s15U [Occ=Once] #) ->
GHC.Types.: @ Char ww4_s15T ww5_s15U
}
}}]
Module.$fShowRatio_$s$cshowsPrec =
\ _ [Occ=Dead] (w1_s15p :: Ratio Integer) (w2_s15q :: String) ->
case w1_s15p of { MkRatio ww1_s15t ww2_s15u ->
case Module.$w$s$cshowsPrec ww1_s15t ww2_s15u w2_s15q of
{ (# ww4_s15T, ww5_s15U #) ->
GHC.Types.: @ Char ww4_s15T ww5_s15U
}
}
-- RHS size: {terms: 14, types: 17, coercions: 0}
lvl_r175 :: Ratio Integer -> String -> [Char]
[GblId, Arity=2, Str=<S(SL),1*U(U,U)><L,U>m2]
lvl_r175 =
\ (w_s15p :: Ratio Integer) (w1_s15q [OS=OneShot] :: String) ->
case w_s15p of { MkRatio ww1_s15t ww2_s15u ->
case Module.$w$s$cshowsPrec ww1_s15t ww2_s15u w1_s15q of
{ (# ww4_s15T, ww5_s15U #) ->
GHC.Types.: @ Char ww4_s15T ww5_s15U
}
}
-- RHS size: {terms: 6, types: 6, coercions: 0}
Module.$fShowRatio_$s$cshowList :: [Ratio Integer] -> ShowS
[GblId,
Arity=2,
Str=<S,1*U><L,U>,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)
Tmpl= \ (ls_a11u [Occ=Once] :: [Ratio Integer])
(s_a11v [Occ=Once] :: String) ->
GHC.Show.showList__
@ (Ratio Integer)
(Module.$fShowRatio_$s$cshowsPrec GHC.Show.shows21)
ls_a11u
s_a11v}]
Module.$fShowRatio_$s$cshowList =
\ (ls_a11u :: [Ratio Integer]) (s_a11v :: String) ->
GHC.Show.showList__ @ (Ratio Integer) lvl_r175 ls_a11u s_a11v
-- RHS size: {terms: 13, types: 17, coercions: 0}
Module.$fShowRatio_$s$cshow :: Ratio Integer -> String
[GblId,
Arity=1,
Str=<S(SL),1*U(U,U)>m2,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
Tmpl= \ (x_a11A [Occ=Once] :: Ratio Integer) ->
Module.$fShowRatio_$s$cshowsPrec
GHC.Show.shows21 x_a11A (GHC.Types.[] @ Char)}]
Module.$fShowRatio_$s$cshow =
\ (x_a11A :: Ratio Integer) ->
case x_a11A of { MkRatio ww1_s15t ww2_s15u ->
case Module.$w$s$cshowsPrec ww1_s15t ww2_s15u (GHC.Types.[] @ Char)
of
{ (# ww4_s15T, ww5_s15U #) ->
GHC.Types.: @ Char ww4_s15T ww5_s15U
}
}
-- RHS size: {terms: 4, types: 2, coercions: 0}
Module.$fShowRatio_$s$fShowRatio [InlPrag=CONLIKE]
:: Show (Ratio Integer)
[GblId,
Str=m,
Unf=DFun: \ ->
GHC.Show.C:Show TYPE: Ratio Integer
Module.$fShowRatio_$s$cshowsPrec
Module.$fShowRatio_$s$cshow
Module.$fShowRatio_$s$cshowList]
Module.$fShowRatio_$s$fShowRatio =
GHC.Show.C:Show
@ (Ratio Integer)
Module.$fShowRatio_$s$cshowsPrec
Module.$fShowRatio_$s$cshow
Module.$fShowRatio_$s$cshowList
-- RHS size: {terms: 2, types: 0, coercions: 0}
Module.$trModule2 :: GHC.Types.TrName
[GblId,
Caf=NoCafRefs,
Str=m1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 20}]
Module.$trModule2 = GHC.Types.TrNameS "main"#
-- RHS size: {terms: 2, types: 0, coercions: 0}
Module.$trModule1 :: GHC.Types.TrName
[GblId,
Caf=NoCafRefs,
Str=m1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 40 20}]
Module.$trModule1 = GHC.Types.TrNameS "Module"#
-- RHS size: {terms: 3, types: 0, coercions: 0}
Module.$trModule :: GHC.Types.Module
[GblId,
Caf=NoCafRefs,
Str=m,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}]
Module.$trModule =
GHC.Types.Module Module.$trModule2 Module.$trModule1
-- RHS size: {terms: 2, types: 0, coercions: 0}
Module.$tc'MkRatio1 :: GHC.Types.TrName
[GblId,
Caf=NoCafRefs,
Str=m1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 40 20}]
Module.$tc'MkRatio1 = GHC.Types.TrNameS "'MkRatio"#
-- RHS size: {terms: 5, types: 0, coercions: 0}
Module.$tc'MkRatio :: GHC.Types.TyCon
[GblId,
Caf=NoCafRefs,
Str=m,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 50}]
Module.$tc'MkRatio =
GHC.Types.TyCon
17366225934913587629##
4537871616602442082##
Module.$trModule
Module.$tc'MkRatio1
-- RHS size: {terms: 2, types: 0, coercions: 0}
Module.$tcRatio1 :: GHC.Types.TrName
[GblId,
Caf=NoCafRefs,
Str=m1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 40 20}]
Module.$tcRatio1 = GHC.Types.TrNameS "Ratio"#
-- RHS size: {terms: 5, types: 0, coercions: 0}
Module.$tcRatio :: GHC.Types.TyCon
[GblId,
Caf=NoCafRefs,
Str=m,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 50}]
Module.$tcRatio =
GHC.Types.TyCon
8023108143494670257##
8265606921531866646##
Module.$trModule
Module.$tcRatio1
-- RHS size: {terms: 2, types: 0, coercions: 0}
Module.$fShowRatio2 :: [Char]
[GblId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False,
WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 40 0}]
Module.$fShowRatio2 = GHC.CString.unpackCString# " % "#
-- RHS size: {terms: 20, types: 14, coercions: 0}
Module.$w$cshowsPrec [InlPrag=[0]]
:: forall a. Show a => a -> a -> ShowS
[GblId,
Arity=3,
Str=<L,U(C(C1(C(U))),A,A)><L,U><L,U>,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 0 0] 180 60}]
Module.$w$cshowsPrec =
\ (@ a_s15A)
(w_s15B :: Show a)
(ww_s15G [OS=OneShot] :: a)
(ww1_s15H [OS=OneShot] :: a) ->
let {
f_a11l :: String -> String
[LclId]
f_a11l = showsPrec @ a w_s15B GHC.Show.shows21 ww_s15G } in
let {
g_X12m :: String -> String
[LclId]
g_X12m = showsPrec @ a w_s15B GHC.Show.shows21 ww1_s15H } in
\ (x_X12r :: String) ->
f_a11l (++ @ Char Module.$fShowRatio2 (g_X12m x_X12r))
-- RHS size: {terms: 11, types: 12, coercions: 0}
Module.$fShowRatio_$cshowsPrec [InlPrag=INLINE[0]]
:: forall a. Show a => Int -> Ratio a -> ShowS
[GblId,
Arity=3,
Str=<L,U(C(C1(C(U))),A,A)><L,A><S,1*U(U,U)>,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=False)
Tmpl= \ (@ a_s15A)
(w_s15B [Occ=Once] :: Show a)
_ [Occ=Dead]
(w2_s15D [Occ=Once!] :: Ratio a) ->
case w2_s15D of
{ MkRatio ww1_s15G [Occ=Once] ww2_s15H [Occ=Once] ->
Module.$w$cshowsPrec @ a w_s15B ww1_s15G ww2_s15H
}}]
Module.$fShowRatio_$cshowsPrec =
\ (@ a_s15A)
(w_s15B :: Show a)
_ [Occ=Dead]
(w2_s15D :: Ratio a) ->
case w2_s15D of { MkRatio ww1_s15G ww2_s15H ->
Module.$w$cshowsPrec @ a w_s15B ww1_s15G ww2_s15H
}
-- RHS size: {terms: 15, types: 10, coercions: 0}
Module.$w$cshow [InlPrag=[0]]
:: forall a. Show a => a -> a -> String
[GblId,
Arity=3,
Str=<S(C(C(C(S)))LL),U(C(C1(C1(U))),A,A)><L,U><L,U>,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 0 0] 130 0}]
Module.$w$cshow =
\ (@ a_s15K)
(w_s15L :: Show a)
(ww_s15P [OS=OneShot] :: a)
(ww1_s15Q [OS=OneShot] :: a) ->
showsPrec
@ a
w_s15L
GHC.Show.shows21
ww_s15P
(++
@ Char
Module.$fShowRatio2
(showsPrec
@ a w_s15L GHC.Show.shows21 ww1_s15Q (GHC.Types.[] @ Char)))
-- RHS size: {terms: 10, types: 11, coercions: 0}
Module.$fShowRatio_$cshow [InlPrag=INLINE[0]]
:: forall a. Show a => Ratio a -> String
[GblId,
Arity=2,
Str=<S(C(C(C(S)))LL),U(C(C1(C1(U))),A,A)><S,1*U(U,U)>,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)
Tmpl= \ (@ a_s15K)
(w_s15L [Occ=Once] :: Show a)
(w1_s15M [Occ=Once!] :: Ratio a) ->
case w1_s15M of
{ MkRatio ww1_s15P [Occ=Once] ww2_s15Q [Occ=Once] ->
Module.$w$cshow @ a w_s15L ww1_s15P ww2_s15Q
}}]
Module.$fShowRatio_$cshow =
\ (@ a_s15K) (w_s15L :: Show a) (w1_s15M :: Ratio a) ->
case w1_s15M of { MkRatio ww1_s15P ww2_s15Q ->
Module.$w$cshow @ a w_s15L ww1_s15P ww2_s15Q
}
-- RHS size: {terms: 15, types: 17, coercions: 0}
Module.$fShowRatio_$cshowList
:: forall a. Show a => [Ratio a] -> ShowS
[GblId,
Arity=3,
Str=<L,U(C(C1(C(U))),A,A)><S,1*U><L,U>,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=False)
Tmpl= \ (@ a_a103)
($dShow_a104 [Occ=Once] :: Show a)
(ls_a11u [Occ=Once] :: [Ratio a])
(s_a11v [Occ=Once] :: String) ->
GHC.Show.showList__
@ (Ratio a)
(Module.$fShowRatio_$cshowsPrec @ a $dShow_a104 GHC.Show.shows21)
ls_a11u
s_a11v}]
Module.$fShowRatio_$cshowList =
\ (@ a_a103)
($dShow_a104 :: Show a)
(ls_a11u :: [Ratio a])
(s_a11v :: String) ->
GHC.Show.showList__
@ (Ratio a)
(\ (w_s15D :: Ratio a) ->
case w_s15D of { MkRatio ww1_s15G ww2_s15H ->
Module.$w$cshowsPrec @ a $dShow_a104 ww1_s15G ww2_s15H
})
ls_a11u
s_a11v
-- RHS size: {terms: 9, types: 9, coercions: 0}
Module.$fShowRatio [InlPrag=CONLIKE]
:: forall a. Show a => Show (Ratio a)
[GblId[DFunId],
Arity=1,
Str=<L,U(C(C1(U)),A,A)>m,
ArgUsg=w*U(w*C^w(C^1(U)),A,A),w*U,w*U..,
Unf=DFun: \ (@ a_aAM) (v_B1 :: Show a) ->
GHC.Show.C:Show TYPE: Ratio a
Module.$fShowRatio_$cshowsPrec @ a v_B1
Module.$fShowRatio_$cshow @ a v_B1
Module.$fShowRatio_$cshowList @ a v_B1]
Module.$fShowRatio =
\ (@ a_a103) ($dShow_a104 :: Show a) ->
GHC.Show.C:Show
@ (Ratio a)
(Module.$fShowRatio_$cshowsPrec @ a $dShow_a104)
(Module.$fShowRatio_$cshow @ a $dShow_a104)
(Module.$fShowRatio_$cshowList @ a $dShow_a104)
------ Local rules for imported ids --------
"SPEC $cshowsPrec"
forall ($dShow_a108 :: Show Integer).
Module.$fShowRatio_$cshowsPrec @ Integer $dShow_a108
= Module.$fShowRatio_$s$cshowsPrec
"SPEC $cshow"
forall ($dShow_a108 :: Show Integer).
Module.$fShowRatio_$cshow @ Integer $dShow_a108
= Module.$fShowRatio_$s$cshow
"SPEC $cshowList"
forall ($dShow_a108 :: Show Integer).
Module.$fShowRatio_$cshowList @ Integer $dShow_a108
= Module.$fShowRatio_$s$cshowList
"SPEC $fShowRatio"
forall ($dShow_a108 :: Show Integer).
Module.$fShowRatio @ Integer $dShow_a108
= Module.$fShowRatio_$s$fShowRatio
-------------- next part --------------
A non-text attachment was scrubbed...
Name: Module.hs
Type: application/octet-stream
Size: 222 bytes
Desc: not available
URL: <http://mail.haskell.org/pipermail/ghc-devs/attachments/20170529/e0dd016a/attachment-0001.obj>
More information about the ghc-devs
mailing list