Ticket #2338: 0001-added-NOUNPACK-pragma-see-2338.patch

File 0001-added-NOUNPACK-pragma-see-2338.patch, 7.0 KB (added by StefanWehr, 4 years ago)
  • compiler/basicTypes/BasicTypes.lhs

    From 929ad1a3266f77aafdf59857b516a6b4202d2dad Mon Sep 17 00:00:00 2001
    From: Stefan Wehr <[email protected]>
    Date: Wed, 9 Nov 2011 09:28:57 +0100
    Subject: [PATCH] added NOUNPACK pragma (see #2338)
    
    ---
     compiler/basicTypes/BasicTypes.lhs  |    2 ++
     compiler/basicTypes/DataCon.lhs     |    1 +
     compiler/iface/BinIface.hs          |    4 +++-
     compiler/parser/Lexer.x             |    2 ++
     compiler/parser/Parser.y.pp         |    2 ++
     compiler/typecheck/TcTyClsDecls.lhs |    1 +
     docs/users_guide/glasgow_exts.xml   |   20 ++++++++++++++++++++
     docs/users_guide/using.xml          |    7 ++++++-
     8 files changed, 37 insertions(+), 2 deletions(-)
    
    diff --git a/compiler/basicTypes/BasicTypes.lhs b/compiler/basicTypes/BasicTypes.lhs
    index 1f42d25..c6226ca 100644
    a b data HsBang = HsNoBang 
    588588            | HsUnpackFailed   -- An UNPACK pragma that we could not make
    589589                               -- use of, because the type isn't unboxable;
    590590                               -- equivalant to HsStrict except for checkValidDataCon
     591            | HsNoUnpack       -- {-# NOUNPACK #-} ! (GHC extension, meaning "strict but not unboxed")
    591592  deriving (Eq, Data, Typeable)
    592593
    593594instance Outputable HsBang where
    instance Outputable HsBang where 
    595596    ppr HsStrict       = char '!'
    596597    ppr HsUnpack       = ptext (sLit "{-# UNPACK #-} !")
    597598    ppr HsUnpackFailed = ptext (sLit "{-# UNPACK (failed) #-} !")
     599    ppr HsNoUnpack     = ptext (sLit "{-# NOUNPACK #-} !")
    598600
    599601isBanged :: HsBang -> Bool
    600602isBanged HsNoBang = False
  • compiler/basicTypes/DataCon.lhs

    diff --git a/compiler/basicTypes/DataCon.lhs b/compiler/basicTypes/DataCon.lhs
    index d171675..2e9125b 100644
    a b computeRep stricts tys 
    952952  where
    953953    unbox HsNoBang       ty = [(NotMarkedStrict, ty)]
    954954    unbox HsStrict       ty = [(MarkedStrict,    ty)]
     955    unbox HsNoUnpack     ty = [(MarkedStrict,    ty)]
    955956    unbox HsUnpackFailed ty = [(MarkedStrict,    ty)]
    956957    unbox HsUnpack ty = zipEqual "computeRep" (dataConRepStrictness arg_dc) arg_tys
    957958                      where
  • compiler/iface/BinIface.hs

    diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
    index 70e5ebb..1c69d20 100644
    a b instance Binary HsBang where 
    773773    put_ bh HsStrict        = putByte bh 1
    774774    put_ bh HsUnpack        = putByte bh 2
    775775    put_ bh HsUnpackFailed  = putByte bh 3
     776    put_ bh HsNoUnpack      = putByte bh 4
    776777    get bh = do
    777778            h <- getByte bh
    778779            case h of
    779780              0 -> do return HsNoBang
    780781              1 -> do return HsStrict
    781782              2 -> do return HsUnpack
    782               _ -> do return HsUnpackFailed
     783              3 -> do return HsUnpackFailed
     784              _ -> do return HsNoUnpack
    783785
    784786instance Binary TupleSort where
    785787    put_ bh BoxedTuple      = putByte bh 0
  • compiler/parser/Lexer.x

    diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
    index 9ae312c..c036d74 100644
    a b data Token 
    477477  | ITgenerated_prag
    478478  | ITcore_prag                 -- hdaume: core annotations
    479479  | ITunpack_prag
     480  | ITnounpack_prag
    480481  | ITann_prag
    481482  | ITclose_prag
    482483  | IToptions_prag String
    oneWordPrags = Map.fromList([("rules", rulePrag), 
    22672268                           ("generated", token ITgenerated_prag),
    22682269                           ("core", token ITcore_prag),
    22692270                           ("unpack", token ITunpack_prag),
     2271                           ("nounpack", token ITnounpack_prag),
    22702272                           ("ann", token ITann_prag),
    22712273                           ("vectorize", token ITvect_prag),
    22722274                           ("novectorize", token ITnovect_prag)])
  • compiler/parser/Parser.y.pp

    diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
    index 62075e7..b1c0bbb 100644
    a b incorrect. 
    263263 '{-# DEPRECATED'         { L _ ITdeprecated_prag }
    264264 '{-# WARNING'            { L _ ITwarning_prag }
    265265 '{-# UNPACK'             { L _ ITunpack_prag }
     266 '{-# NOUNPACK'           { L _ ITnounpack_prag }
    266267 '{-# ANN'                { L _ ITann_prag }
    267268 '{-# VECTORISE'          { L _ ITvect_prag }
    268269 '{-# VECTORISE_SCALAR'   { L _ ITvect_scalar_prag }
    infixtype :: { LHsType RdrName } 
    973974strict_mark :: { Located HsBang }
    974975        : '!'                           { L1 HsStrict }
    975976        | '{-# UNPACK' '#-}' '!'        { LL HsUnpack }
     977        | '{-# NOUNPACK' '#-}' '!'      { LL HsNoUnpack }
    976978
    977979-- A ctype is a for-all type
    978980ctype   :: { LHsType RdrName }
  • compiler/typecheck/TcTyClsDecls.lhs

    diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs
    index 7a56db4..aaa311b 100644
    a b chooseBoxingStrategy arg_ty bang 
    926926        HsStrict -> do { unbox_strict <- doptM Opt_UnboxStrictFields
    927927                       ; if unbox_strict then return (can_unbox HsStrict arg_ty)
    928928                                         else return HsStrict }
     929        HsNoUnpack -> return HsStrict
    929930        HsUnpack -> do { omit_prags <- doptM Opt_OmitInterfacePragmas
    930931            -- Do not respect UNPACK pragmas if OmitInterfacePragmas is on
    931932            -- See Trac #5252: unpacking means we must not conceal the
  • docs/users_guide/glasgow_exts.xml

    diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml
    index 5123e10..6d1b293 100755
    a b data S = S {-# UNPACK #-} !Int {-# UNPACK #-} !Int 
    85758575      constructor field.</para>
    85768576    </sect2>
    85778577
     8578    <sect2 id="nounpack-pragma">
     8579      <title>NOUNPACK pragma</title>
     8580
     8581      <indexterm><primary>NOUNPACK</primary></indexterm>
     8582
     8583      <para>The <literal>NOUNPACK</literal> pragma indicates to the compiler
     8584      that it should not unpack the contents of a constructor field.
     8585      Example:
     8586      </para>
     8587<programlisting>
     8588data T = T {-# NOUNPACK #-} !(Int,Int)
     8589</programlisting>
     8590      <para>
     8591        Even with the flags
     8592        <option>-funbox-strict-fields</option> and <option>-O</option>,
     8593        the field of the constructor <function>T</function> is not
     8594        unpacked.
     8595      </para>
     8596    </sect2>
     8597
    85788598    <sect2 id="source-pragma">
    85798599      <title>SOURCE pragma</title>
    85808600
  • docs/users_guide/using.xml

    diff --git a/docs/users_guide/using.xml b/docs/users_guide/using.xml
    index eccd6f9..4cace1e 100644
    a b f "2" = 2 
    19321932            <para>This option is a bit of a sledgehammer: it might
    19331933            sometimes make things worse.  Selectively unboxing fields
    19341934            by using <literal>UNPACK</literal> pragmas might be
    1935             better.</para>
     1935            better. An alternative is to use
     1936        <option>-funbox-strict-fields</option> to turn on
     1937        unboxing by default but disable it for certain constructor
     1938        fields using the <literal>NOUNPACK</literal> pragma
     1939        (see <xref linkend="nounpack-pragma"/>).
     1940        </para>
    19361941          </listitem>
    19371942        </varlistentry>
    19381943