[commit: ghc] master: added NOUNPACK pragma (see #2338) (aa56423)
Johan Tibell
johan.tibell at gmail.com
Wed Nov 9 16:34:34 CET 2011
This is great.
P.S. Have someone tried to compile e.g. fibon or some other more realistic
benchmark with -funbox-strict-fields? I guess one problem might be that not
enough fields are made strict though...
On Wed, Nov 9, 2011 at 3:36 AM, Simon Marlow <marlowsd at gmail.com> wrote:
> Repository : ssh://darcs.haskell.org//srv/darcs/ghc
>
> On branch : master
>
>
> http://hackage.haskell.org/trac/ghc/changeset/aa564232ee67d46403a69b02b0b8faf2455894f8
>
> >---------------------------------------------------------------
>
> commit aa564232ee67d46403a69b02b0b8faf2455894f8
> Author: Stefan Wehr <wehr at factisresearch.com>
> Date: Wed Nov 9 09:37:17 2011 +0100
>
> 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/compiler/basicTypes/BasicTypes.lhs
> +++ b/compiler/basicTypes/BasicTypes.lhs
> @@ -588,6 +588,7 @@ data HsBang = HsNoBang
> | HsUnpackFailed -- An UNPACK pragma that we could not make
> -- use of, because the type isn't unboxable;
> -- equivalant to HsStrict except for
> checkValidDataCon
> + | HsNoUnpack -- {-# NOUNPACK #-} ! (GHC extension,
> meaning "strict but not unboxed")
> deriving (Eq, Data, Typeable)
>
> instance Outputable HsBang where
> @@ -595,6 +596,7 @@ instance Outputable HsBang where
> ppr HsStrict = char '!'
> ppr HsUnpack = ptext (sLit "{-# UNPACK #-} !")
> ppr HsUnpackFailed = ptext (sLit "{-# UNPACK (failed) #-} !")
> + ppr HsNoUnpack = ptext (sLit "{-# NOUNPACK #-} !")
>
> isBanged :: HsBang -> Bool
> isBanged HsNoBang = False
> diff --git a/compiler/basicTypes/DataCon.lhs
> b/compiler/basicTypes/DataCon.lhs
> index d171675..2e9125b 100644
> --- a/compiler/basicTypes/DataCon.lhs
> +++ b/compiler/basicTypes/DataCon.lhs
> @@ -952,6 +952,7 @@ computeRep stricts tys
> where
> unbox HsNoBang ty = [(NotMarkedStrict, ty)]
> unbox HsStrict ty = [(MarkedStrict, ty)]
> + unbox HsNoUnpack ty = [(MarkedStrict, ty)]
> unbox HsUnpackFailed ty = [(MarkedStrict, ty)]
> unbox HsUnpack ty = zipEqual "computeRep" (dataConRepStrictness
> arg_dc) arg_tys
> where
> diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
> index 70e5ebb..1c69d20 100644
> --- a/compiler/iface/BinIface.hs
> +++ b/compiler/iface/BinIface.hs
> @@ -773,13 +773,15 @@ instance Binary HsBang where
> put_ bh HsStrict = putByte bh 1
> put_ bh HsUnpack = putByte bh 2
> put_ bh HsUnpackFailed = putByte bh 3
> + put_ bh HsNoUnpack = putByte bh 4
> get bh = do
> h <- getByte bh
> case h of
> 0 -> do return HsNoBang
> 1 -> do return HsStrict
> 2 -> do return HsUnpack
> - _ -> do return HsUnpackFailed
> + 3 -> do return HsUnpackFailed
> + _ -> do return HsNoUnpack
>
> instance Binary TupleSort where
> put_ bh BoxedTuple = putByte bh 0
> diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
> index 9ae312c..c036d74 100644
> --- a/compiler/parser/Lexer.x
> +++ b/compiler/parser/Lexer.x
> @@ -477,6 +477,7 @@ data Token
> | ITgenerated_prag
> | ITcore_prag -- hdaume: core annotations
> | ITunpack_prag
> + | ITnounpack_prag
> | ITann_prag
> | ITclose_prag
> | IToptions_prag String
> @@ -2267,6 +2268,7 @@ oneWordPrags = Map.fromList([("rules", rulePrag),
> ("generated", token ITgenerated_prag),
> ("core", token ITcore_prag),
> ("unpack", token ITunpack_prag),
> + ("nounpack", token ITnounpack_prag),
> ("ann", token ITann_prag),
> ("vectorize", token ITvect_prag),
> ("novectorize", token ITnovect_prag)])
> diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
> index 62075e7..b1c0bbb 100644
> --- a/compiler/parser/Parser.y.pp
> +++ b/compiler/parser/Parser.y.pp
> @@ -263,6 +263,7 @@ incorrect.
> '{-# DEPRECATED' { L _ ITdeprecated_prag }
> '{-# WARNING' { L _ ITwarning_prag }
> '{-# UNPACK' { L _ ITunpack_prag }
> + '{-# NOUNPACK' { L _ ITnounpack_prag }
> '{-# ANN' { L _ ITann_prag }
> '{-# VECTORISE' { L _ ITvect_prag }
> '{-# VECTORISE_SCALAR' { L _ ITvect_scalar_prag }
> @@ -973,6 +974,7 @@ infixtype :: { LHsType RdrName }
> strict_mark :: { Located HsBang }
> : '!' { L1 HsStrict }
> | '{-# UNPACK' '#-}' '!' { LL HsUnpack }
> + | '{-# NOUNPACK' '#-}' '!' { LL HsNoUnpack }
>
> -- A ctype is a for-all type
> ctype :: { LHsType RdrName }
> diff --git a/compiler/typecheck/TcTyClsDecls.lhs
> b/compiler/typecheck/TcTyClsDecls.lhs
> index 7a56db4..aaa311b 100644
> --- a/compiler/typecheck/TcTyClsDecls.lhs
> +++ b/compiler/typecheck/TcTyClsDecls.lhs
> @@ -926,6 +926,7 @@ chooseBoxingStrategy arg_ty bang
> HsStrict -> do { unbox_strict <- doptM Opt_UnboxStrictFields
> ; if unbox_strict then return (can_unbox HsStrict
> arg_ty)
> else return HsStrict }
> + HsNoUnpack -> return HsStrict
> HsUnpack -> do { omit_prags <- doptM Opt_OmitInterfacePragmas
> -- Do not respect UNPACK pragmas if OmitInterfacePragmas is on
> -- See Trac #5252: unpacking means we must not conceal the
> diff --git a/docs/users_guide/glasgow_exts.xml
> b/docs/users_guide/glasgow_exts.xml
> index 5123e10..6d1b293 100755
> --- a/docs/users_guide/glasgow_exts.xml
> +++ b/docs/users_guide/glasgow_exts.xml
> @@ -8575,6 +8575,26 @@ data S = S {-# UNPACK #-} !Int {-# UNPACK #-} !Int
> constructor field.</para>
> </sect2>
>
> + <sect2 id="nounpack-pragma">
> + <title>NOUNPACK pragma</title>
> +
> + <indexterm><primary>NOUNPACK</primary></indexterm>
> +
> + <para>The <literal>NOUNPACK</literal> pragma indicates to the
> compiler
> + that it should not unpack the contents of a constructor field.
> + Example:
> + </para>
> +<programlisting>
> +data T = T {-# NOUNPACK #-} !(Int,Int)
> +</programlisting>
> + <para>
> + Even with the flags
> + <option>-funbox-strict-fields</option> and <option>-O</option>,
> + the field of the constructor <function>T</function> is not
> + unpacked.
> + </para>
> + </sect2>
> +
> <sect2 id="source-pragma">
> <title>SOURCE pragma</title>
>
> diff --git a/docs/users_guide/using.xml b/docs/users_guide/using.xml
> index eccd6f9..4cace1e 100644
> --- a/docs/users_guide/using.xml
> +++ b/docs/users_guide/using.xml
> @@ -1932,7 +1932,12 @@ f "2" = 2
> <para>This option is a bit of a sledgehammer: it might
> sometimes make things worse. Selectively unboxing fields
> by using <literal>UNPACK</literal> pragmas might be
> - better.</para>
> + better. An alternative is to use
> + <option>-funbox-strict-fields</option> to turn on
> + unboxing by default but disable it for certain constructor
> + fields using the <literal>NOUNPACK</literal> pragma
> + (see <xref linkend="nounpack-pragma"/>).
> + </para>
> </listitem>
> </varlistentry>
>
>
>
>
> _______________________________________________
> Cvs-ghc mailing list
> Cvs-ghc at haskell.org
> http://www.haskell.org/mailman/listinfo/cvs-ghc
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/cvs-ghc/attachments/20111109/508b38a2/attachment.htm>
More information about the Cvs-ghc
mailing list