added NOUNPACK pragma (see #2338)
authorStefan Wehr <wehr@factisresearch.com>
Wed, 9 Nov 2011 08:37:17 +0000 (09:37 +0100)
committerSimon Marlow <marlowsd@gmail.com>
Wed, 9 Nov 2011 10:38:33 +0000 (10:38 +0000)
compiler/basicTypes/BasicTypes.lhs
compiler/basicTypes/DataCon.lhs
compiler/iface/BinIface.hs
compiler/parser/Lexer.x
compiler/parser/Parser.y.pp
compiler/typecheck/TcTyClsDecls.lhs
docs/users_guide/glasgow_exts.xml
docs/users_guide/using.xml

index 1f42d25..c6226ca 100644 (file)
@@ -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
index d171675..2e9125b 100644 (file)
@@ -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
index 70e5ebb..1c69d20 100644 (file)
@@ -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
index 9ae312c..c036d74 100644 (file)
@@ -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)])
index 62075e7..b1c0bbb 100644 (file)
@@ -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 }
index 7a56db4..aaa311b 100644 (file)
@@ -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
index 5123e10..6d1b293 100755 (executable)
@@ -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>
 
index eccd6f9..4cace1e 100644 (file)
@@ -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>