StgRhsClosure freevar and argument name duplicates
Csaba Hruska
csaba.hruska at gmail.com
Mon Nov 5 16:33:20 UTC 2018
Correction!
The problem happens in integer-gmp:
https://github.com/ghc/ghc/blob/master/libraries/integer-gmp/src/GHC/Integer/Type.hs#L761-L770
On Mon, Nov 5, 2018 at 5:27 PM Csaba Hruska <csaba.hruska at gmail.com> wrote:
> An example for the duplication please check the divModInteger
> <https://github.com/ghc/ghc/blob/master/libraries/integer-simple/GHC/Integer/Type.hs#L373-L380>
> function from integer-simple GHC.Integer.Type.
> The STG (GHC 8.2.2) generated from *divModInteger **:: Integer -> Integer
> -> (# Integer, Integer #) *contains duplications in a closure binder list.
>
> Using my custom STG printer it looks like:
> module GHC.Integer.Type where
>
> using GHC.Prim
> using GHC.Tuple
> using GHC.Types
>
> GHC.Integer.Type.divModInteger {-083-} =
> closure (F:) (B:
> n.s84123 {-s84123-}
> d.s84124 {-s84124-}) {
> case GHC.Integer.Type.quotRemInteger {-084-}
> n.s84123 {-s84123-}
> d.s84124 {-s84124-}
> of qr.s84125 {-s84125-} {
> GHC.Prim.(#,#) {-86-} ipv.s84126 {-s84126-} ipv1.s84127 {-s84127-} ->
> let $j.s84128 {-s84128-} =
> closure (F:
> d.s84124 {-s84124-}
> * ipv.s84126 {-s84126-}*
> * ipv1.s84127 {-s84127-}*
> * ipv.s84126 {-s84126-}*
> *ipv1.s84127 {-s84127-}*) (B:
> wild.s84129 {-s84129-}) {
> let $j1.s84130 {-s84130-} =
> closure (F:
> d.s84124 {-s84124-}
> ipv.s84126 {-s84126-}
> ipv1.s84127 {-s84127-}
> ipv.s84126 {-s84126-}
> ipv1.s84127 {-s84127-}
> wild.s84129 {-s84129-}) (B:
> wild1.s84131 {-s84131-}) {
> case _stg_prim_negateInt#
> wild.s84129 {-s84129-}
> of sat.s84132 {-s84132-} {
> DEFAULT ->
> case _stg_prim_==#
> wild1.s84131 {-s84131-}
> sat.s84132 {-s84132-}
> of sat.s84133 {-s84133-} {
> DEFAULT ->
> case _stg_prim_tagToEnum#
> sat.s84133 {-s84133-}
> of wild2.s84134 {-s84134-} {
> GHC.Types.False {-612-} ->
> GHC.Prim.(#,#) {-86-}
> ipv.s84126 {-s84126-}
> ipv1.s84127 {-s84127-}
> GHC.Types.True {-645-} ->
> case GHC.Integer.Type.plusInteger {-066-}
> ipv1.s84127 {-s84127-}
> d.s84124 {-s84124-}
> of r'.s84135 {-s84135-} {
> DEFAULT ->
> case GHC.Integer.Type.plusInteger {-066-}
> ipv.s84126 {-s84126-}
> GHC.Integer.Type.lvl11 {-r50574-}
> of q'.s84136 {-s84136-} {
> DEFAULT ->
> GHC.Prim.(#,#) {-86-}
> q'.s84136 {-s84136-}
> r'.s84135 {-s84135-}
> }
> }
> }
> }
> }}
>
> in case ipv1.s84127 {-s84127-}
> of wild1.s84137 {-s84137-} {
> GHC.Integer.Type.S# {-621-} i#.s84138 {-s84138-} ->
> case _stg_prim_<#
> i#.s84138 {-s84138-} 0#
> of sat.s84140 {-s84140-} {
> DEFAULT ->
> case _stg_prim_>#
> i#.s84138 {-s84138-} 0#
> of sat.s84139 {-s84139-} {
> DEFAULT ->
> case _stg_prim_-#
> sat.s84139 {-s84139-}
> sat.s84140 {-s84140-}
> of sat.s84141 {-s84141-} {
> DEFAULT ->
> $j1.s84130 {-s84130-}
> sat.s84141 {-s84141-}
> }
> }
> }
> GHC.Integer.Type.Jp# {-r5813-} dt.s84142 {-s84142-} ->
> $j1.s84130 {-s84130-} 1#
> GHC.Integer.Type.Jn# {-r5814-} dt.s84143 {-s84143-} ->
> $j1.s84130 {-s84130-} -1#
> }}
>
> in case d.s84124 {-s84124-}
> of wild.s84144 {-s84144-} {
> GHC.Integer.Type.S# {-621-} i#.s84145 {-s84145-} ->
> case _stg_prim_<#
> i#.s84145 {-s84145-} 0#
> of sat.s84147 {-s84147-} {
> DEFAULT ->
> case _stg_prim_>#
> i#.s84145 {-s84145-} 0#
> of sat.s84146 {-s84146-} {
> DEFAULT ->
> case _stg_prim_-#
> sat.s84146 {-s84146-}
> sat.s84147 {-s84147-}
> of sat.s84148 {-s84148-} {
> DEFAULT ->
> $j.s84128 {-s84128-}
> sat.s84148 {-s84148-}
> }
> }
> }
> GHC.Integer.Type.Jp# {-r5813-} dt.s84149 {-s84149-} ->
> $j.s84128 {-s84128-} 1#
> GHC.Integer.Type.Jn# {-r5814-} dt.s84150 {-s84150-} ->
> $j.s84128 {-s84128-} -1#
> }
> }}
>
>
> On Mon, Nov 5, 2018 at 2:08 PM Simon Peyton Jones <simonpj at microsoft.com>
> wrote:
>
>> I don’t think there should be duplicates in either. Do you have a test
>> case that shows duplicates?
>>
>>
>>
>> Simon
>>
>>
>>
>> *From:* ghc-devs <ghc-devs-bounces at haskell.org> *On Behalf Of *Csaba
>> Hruska
>> *Sent:* 04 November 2018 11:22
>> *To:* ghc-devs at haskell.org
>> *Subject:* Re: StgRhsClosure freevar and argument name duplicates
>>
>>
>>
>> Is it possible that GHC generates STG with invalid binding semantics for
>> certain cases that the Cmm codegen fix or ignore?
>>
>> This could explain my observations.
>>
>> I've checked the Stg linter source (StgLint.hs ; GHC 8.2.2 and github
>> master) and it does not check StgRhsClosure free var and binder list at all.
>>
>> And the scope checker function (addInScopeVars) does not check for
>> duplicates.
>>
>>
>>
>> Any thoughts?
>>
>>
>>
>> Cheers,
>>
>> Csaba
>>
>>
>>
>> On Sat, Nov 3, 2018 at 9:53 AM Csaba Hruska <csaba.hruska at gmail.com>
>> wrote:
>>
>> Hi,
>>
>>
>>
>> Can StgRhsClosure's freevar list ([occ]) or argument list ([bndr])
>> contain duplicates?
>>
>>
>>
>> Cheers,
>>
>> Csaba
>>
>>
>>
>> data GenStgRhs bndr occ
>> = StgRhsClosure
>> CostCentreStack -- CCS to be attached (default is
>> CurrentCCS)
>> StgBinderInfo -- Info about how this binder is used
>> (see below)
>> *[occ]* -- non-global free vars; a list,
>> rather than
>> -- a set, because order is important
>> !UpdateFlag -- ReEntrant | Updatable | SingleEntry
>> *[bndr]* -- arguments; if empty, then not a
>> function;
>> -- as above, order is important.
>> (GenStgExpr bndr occ) -- body
>>
>>
>>
>>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-devs/attachments/20181105/bf03aaca/attachment.html>
More information about the ghc-devs
mailing list