[Git][ghc/ghc][wip/scc-parsing] 5 commits: Fix typo in 8.8.1 notes related to traceBinaryEvent

Vladislav Zavialov gitlab at gitlab.haskell.org
Mon May 6 14:04:40 UTC 2019



Vladislav Zavialov pushed to branch wip/scc-parsing at Glasgow Haskell Compiler / GHC


Commits:
63150b9e by iustin at 2019-05-04T21:54:23Z
Fix typo in 8.8.1 notes related to traceBinaryEvent

- fixes double mention of `traceBinaryEvent#` (the second one should be `traceEvent#`, I think)
- fixes note about `traceEvent#` taking a `String` - the docs say it takes a zero-terminated ByteString.
- - - - -
dc8a5868 by gallais at 2019-05-04T22:00:30Z
[ typo ] 'castFloatToWord32' -> 'castFloatToWord64'

Probably due to a copy/paste gone wrong.
- - - - -
615b4be6 by Chaitanya Koparkar at 2019-05-05T14:39:24Z
Fix #16593 by having only one definition of -fprint-explicit-runtime-reps

[skip ci]

- - - - -
ead3f835 by Vladislav Zavialov at 2019-05-05T14:39:24Z
'warnSpaceAfterBang' only in patterns (#16619)

- - - - -
9fce9714 by Vladislav Zavialov at 2019-05-06T14:03:18Z
Meaning-preserving SCC annotations (#15730)

- - - - -


15 changed files:

- compiler/parser/Parser.y
- compiler/parser/RdrHsSyn.hs
- docs/users_guide/8.8.1-notes.rst
- docs/users_guide/glasgow_exts.rst
- docs/users_guide/using.rst
- libraries/base/GHC/Float.hs
- + testsuite/tests/parser/should_compile/T16619.hs
- + testsuite/tests/parser/should_compile/T16619a.hs
- testsuite/tests/parser/should_compile/all.T
- + testsuite/tests/parser/should_fail/T15730.hs
- + testsuite/tests/parser/should_fail/T15730.stderr
- testsuite/tests/parser/should_fail/all.T
- testsuite/tests/perf/compiler/T15164.hs
- testsuite/tests/profiling/should_run/prof-doc-last.hs
- testsuite/tests/profiling/should_run/prof-doc-last.prof.sample


Changes:

=====================================
compiler/parser/Parser.y
=====================================
@@ -1064,7 +1064,7 @@ topdecl :: { LHsDecl GhcPs }
         -- The $(..) form is one possible form of infixexp
         -- but we treat an arbitrary expression just as if
         -- it had a $(..) wrapped around it
-        | infixexp_top                          {% runECP_P $1 >>= \ $1 ->
+        | infixexp                              {% runECP_P $1 >>= \ $1 ->
                                                    return $ sLL $1 $> $ mkSpliceDecl $1 }
 
 -- Type classes
@@ -2411,7 +2411,7 @@ decl_no_th :: { LHsDecl GhcPs }
                                         _ <- amsL l (ann ++ fst (unLoc $3) ++ [mj AnnBang $1]) ;
                                         return $! (sL l $ ValD noExt r) } }
 
-        | infixexp_top opt_sig rhs  {% runECP_P $1 >>= \ $1 ->
+        | infixexp     opt_sig rhs  {% runECP_P $1 >>= \ $1 ->
                                        do { (ann,r) <- checkValDef NoSrcStrict $1 (snd $2) $3;
                                         let { l = comb2 $1 $> };
                                         -- Depending upon what the pattern looks like we might get either
@@ -2457,7 +2457,7 @@ gdrh :: { LGRHS GhcPs (LHsExpr GhcPs) }
 sigdecl :: { LHsDecl GhcPs }
         :
         -- See Note [Declaration/signature overlap] for why we need infixexp here
-          infixexp_top '::' sigtypedoc
+          infixexp     '::' sigtypedoc
                         {% do { $1 <- runECP_P $1
                               ; v <- checkValSigLhs $1
                               ; _ <- amsL (comb2 $1 $>) [mu AnnDcolon $2]
@@ -2581,63 +2581,54 @@ exp   :: { ECP }
                                                       HsHigherOrderApp False)
                                        [mu AnnRarrowtail $2] }
         | infixexp              { $1 }
+        | exp_ann exp           {% runECP_P $2 >>= \ $2 -> fmap ecpFromExp $ $1 $2 }
 
 infixexp :: { ECP }
-        : exp10 { $1 }
-        | infixexp qop exp10  {  ECP $
-                                 superInfixOp $
-                                 $2 >>= \ $2 ->
-                                 runECP_PV $1 >>= \ $1 ->
-                                 runECP_PV $3 >>= \ $3 ->
-                                 amms (mkHsOpAppPV (comb2 $1 $>) $1 $2 $3)
-                                     [mj AnnVal $2] }
-                 -- AnnVal annotation for NPlusKPat, which discards the operator
-
-infixexp_top :: { ECP }
-            : exp10_top               { $1 }
-            | infixexp_top qop exp10_top
-                                      { ECP $
-                                         superInfixOp $
-                                         $2 >>= \ $2 ->
-                                         runECP_PV $1 >>= \ $1 ->
-                                         runECP_PV $3 >>= \ $3 ->
-                                         do { when (srcSpanEnd (getLoc $2)
-                                                == srcSpanStart (getLoc $3)
-                                                && checkIfBang (unLoc $2)) $
-                                                warnSpaceAfterBang (comb2 $2 $3);
-                                              amms (mkHsOpAppPV (comb2 $1 $>) $1 $2 $3)
-                                                   [mj AnnVal $2]
-                                            }
-                                      }
-
-exp10_top :: { ECP }
+        : infixexp_inner         { $1 }
+        | infixexp_inner qop exp_ann exp10
+                                 {% runPV $2 >>= \ $2 ->
+                                    runECP_P $1 >>= \ $1 ->
+                                    runECP_P $4 >>= \ $4 ->
+                                    $3 $4 >>= \last ->
+                                    fmap ecpFromExp $
+                                    ams (sLL $1 last $ OpApp noExt $1 $2 last)
+                                         [mj AnnVal $2] }
+             -- AnnVal annotation for NPlusKPat, which discards the operator
+
+infixexp_inner :: { ECP }
+        : exp10                   { $1 }
+        | infixexp_inner qop exp10
+                                  { ECP $
+                                     superInfixOp $
+                                     $2 >>= \ $2 ->
+                                     runECP_PV $1 >>= \ $1 ->
+                                     runECP_PV $3 >>= \ $3 ->
+                                     amms (mkHsOpAppPV (comb2 $1 $>) $1 $2 $3)
+                                          [mj AnnVal $2] }
+             -- AnnVal annotation for NPlusKPat, which discards the operator
+
+exp_ann :: { LHsExpr GhcPs -> P (LHsExpr GhcPs) }
+  : scc_annot { \exp ->
+      ams (sLL $1 exp $ HsSCC noExt (snd $ fst $ unLoc $1) (snd $ unLoc $1) exp)
+          (fst $ fst $ unLoc $1) }
+  | hpc_annot { \exp ->
+      ams (sLL $1 exp $ HsTickPragma noExt (snd $ fst $ fst $ unLoc $1)
+                                           (snd $ fst $ unLoc $1) (snd $ unLoc $1) exp)
+          (fst $ fst $ fst $ unLoc $1) }
+
+  | '{-# CORE' STRING '#-}' { \exp ->
+      ams (sLL $1 exp $ HsCoreAnn noExt (getCORE_PRAGs $1) (getStringLiteral $2) exp)
+          [mo $1,mj AnnVal $2
+          ,mc $3] }
+       -- hdaume: core annotation
+
+exp10 :: { ECP }
         : '-' fexp                      { ECP $
                                            runECP_PV $2 >>= \ $2 ->
                                            amms (mkHsNegAppPV (comb2 $1 $>) $2)
                                                [mj AnnMinus $1] }
-
-
-        | hpc_annot exp        {% runECP_P $2 >>= \ $2 ->
-                                  fmap ecpFromExp $
-                                  ams (sLL $1 $> $ HsTickPragma noExt (snd $ fst $ fst $ unLoc $1)
-                                                                (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
-                                      (fst $ fst $ fst $ unLoc $1) }
-
-        | '{-# CORE' STRING '#-}' exp  {% runECP_P $4 >>= \ $4 ->
-                                          fmap ecpFromExp $
-                                          ams (sLL $1 $> $ HsCoreAnn noExt (getCORE_PRAGs $1) (getStringLiteral $2) $4)
-                                              [mo $1,mj AnnVal $2
-                                              ,mc $3] }
-                                          -- hdaume: core annotation
         | fexp                         { $1 }
 
-exp10 :: { ECP }
-        : exp10_top            { $1 }
-        | scc_annot exp        {% runECP_P $2 >>= \ $2 ->
-                                  fmap ecpFromExp $
-                                  ams (sLL $1 $> $ HsSCC noExt (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
-                                      (fst $ fst $ unLoc $1) }
-
 optSemi :: { ([Located Token],Bool) }
         : ';'         { ([$1],True) }
         | {- empty -} { ([],False) }
@@ -2906,7 +2897,7 @@ texp :: { ECP }
         -- Then when converting expr to pattern we unravel it again
         -- Meanwhile, the renamer checks that real sections appear
         -- inside parens.
-        | infixexp qop       {% runECP_P $1 >>= \ $1 ->
+        | infixexp_inner qop {% runECP_P $1 >>= \ $1 ->
                                 runPV $2 >>= \ $2 ->
                                 return $ ecpFromExp $
                                 sLL $1 $> $ SectionL noExt $1 $2 }
@@ -3963,17 +3954,6 @@ hintExplicitForall tok = do
   where
     forallSymDoc = text (forallSym (isUnicode tok))
 
--- | Warn about missing space after bang
-warnSpaceAfterBang :: SrcSpan -> PV ()
-warnSpaceAfterBang span = do
-    bang_on <- getBit BangPatBit
-    unless bang_on $
-      addWarning Opt_WarnSpaceAfterBang span msg
-    where
-      msg = text "Did you forget to enable BangPatterns?" $$
-            text "If you mean to bind (!) then perhaps you want" $$
-            text "to add a space after the bang for clarity."
-
 -- When two single quotes don't followed by tyvar or gtycon, we report the
 -- error as empty character literal, or TH quote that missing proper type
 -- variable or constructor. See #13450.


=====================================
compiler/parser/RdrHsSyn.hs
=====================================
@@ -1847,20 +1847,16 @@ ecpFromCmd a = ECP (ecpFromCmd' a)
 -- | Disambiguate infix operators.
 -- See Note [Ambiguous syntactic categories]
 class DisambInfixOp b where
-  checkIfBang :: b -> Bool
   mkHsVarOpPV :: Located RdrName -> PV (Located b)
   mkHsConOpPV :: Located RdrName -> PV (Located b)
   mkHsInfixHolePV :: SrcSpan -> PV (Located b)
 
 instance p ~ GhcPs => DisambInfixOp (HsExpr p) where
-  checkIfBang (HsVar _ (unLoc -> op)) = isBangRdr op
-  checkIfBang _ = False
   mkHsVarOpPV v = return $ cL (getLoc v) (HsVar noExt v)
   mkHsConOpPV v = return $ cL (getLoc v) (HsVar noExt v)
   mkHsInfixHolePV l = return $ cL l hsHoleExpr
 
 instance DisambInfixOp RdrName where
-  checkIfBang = isBangRdr
   mkHsConOpPV (dL->L l v) = return $ cL l v
   mkHsVarOpPV (dL->L l v) = return $ cL l v
   mkHsInfixHolePV l =
@@ -2132,7 +2128,9 @@ instance p ~ GhcPs => DisambECP (PatBuilder p) where
   mkHsLetPV l _ _ = addFatalError l $ text "(let ... in ...)-syntax in pattern"
   type InfixOp (PatBuilder p) = RdrName
   superInfixOp m = m
-  mkHsOpAppPV l p1 op p2 = return $ cL l $ PatBuilderOpApp p1 op p2
+  mkHsOpAppPV l p1 op p2 = do
+    warnSpaceAfterBang op (getLoc p2)
+    return $ cL l $ PatBuilderOpApp p1 op p2
   mkHsCasePV l _ _ = addFatalError l $ text "(case ... of ...)-syntax in pattern"
   type FunArg (PatBuilder p) = PatBuilder p
   superFunArg m = m
@@ -2193,6 +2191,19 @@ mkPatRec (unLoc -> PatBuilderVar c) (HsRecFields fs dd)
 mkPatRec p _ =
   addFatalError (getLoc p) $ text "Not a record constructor:" <+> ppr p
 
+-- | Warn about missing space after bang
+warnSpaceAfterBang :: Located RdrName -> SrcSpan -> PV ()
+warnSpaceAfterBang (dL->L opLoc op) argLoc = do
+    bang_on <- getBit BangPatBit
+    when (not bang_on && noSpace && isBangRdr op) $
+      addWarning Opt_WarnSpaceAfterBang span msg
+    where
+      span = combineSrcSpans opLoc argLoc
+      noSpace = srcSpanEnd opLoc == srcSpanStart argLoc
+      msg = text "Did you forget to enable BangPatterns?" $$
+            text "If you mean to bind (!) then perhaps you want" $$
+            text "to add a space after the bang for clarity."
+
 {- Note [Ambiguous syntactic categories]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 


=====================================
docs/users_guide/8.8.1-notes.rst
=====================================
@@ -149,8 +149,9 @@ Template Haskell
 ~~~~~~~~~~~~~~~~~~~~
 
 - GHC now exposes a new primop, ``traceBinaryEvent#``. This primop writes
-  eventlog events similar to ``traceBinaryEvent#`` but allows the user to pass
-  the event payload as a binary blob instead of a ``String``.
+  eventlog events similar to ``traceEvent#`` but allows the user to pass
+  the event payload as a binary blob instead of a zero-terminated
+  ``ByteString``.
 
 - The ``StableName#`` type parameter now has a phantom role instead of
   a representational one. There is really no reason to care about the


=====================================
docs/users_guide/glasgow_exts.rst
=====================================
@@ -9625,7 +9625,17 @@ when printing, and printing ``TYPE 'LiftedRep`` as ``Type`` (or ``*`` when
 :extension:`StarIsType` is on).
 
 Should you wish to see levity polymorphism in your types, enable
-the flag :ghc-flag:`-fprint-explicit-runtime-reps`.
+the flag :ghc-flag:`-fprint-explicit-runtime-reps`. For example,
+
+    .. code-block:: none
+
+        ghci> :t ($)
+        ($) :: (a -> b) -> a -> b
+        ghci> :set -fprint-explicit-runtime-reps
+        ghci> :t ($)
+        ($)
+          :: forall (r :: GHC.Types.RuntimeRep) a (b :: TYPE r).
+             (a -> b) -> a -> b
 
 .. _type-level-literals:
 


=====================================
docs/users_guide/using.rst
=====================================
@@ -810,27 +810,6 @@ messages and in GHCi:
     exposed to the programmer, but it is nevertheless displayed when
     :ghc-flag:`-fprint-explicit-kinds` is enabled.
 
-.. ghc-flag:: -fprint-explicit-runtime-reps
-    :shortdesc: Print ``RuntimeRep`` variables in types which are
-        runtime-representation polymorphic.
-    :type: dynamic
-    :reverse: -fno-print-explicit-runtime-reps
-    :category: verbosity
-
-    When :ghc-flag:`-fprint-explicit-runtime-reps` is enabled, GHC prints
-    ``RuntimeRep`` type variables for levity-polymorphic types.
-    Otherwise GHC will default these to ``LiftedRep``. For example,
-
-    .. code-block:: none
-
-        ghci> :t ($)
-        ($) :: (a -> b) -> a -> b
-        ghci> :set -fprint-explicit-runtime-reps
-        ghci> :t ($)
-        ($)
-          :: forall (r :: GHC.Types.RuntimeRep) a (b :: TYPE r).
-             (a -> b) -> a -> b
-
 .. ghc-flag:: -fprint-explicit-coercions
     :shortdesc: Print coercions in types
     :type: dynamic
@@ -1131,4 +1110,3 @@ Some flags only make sense for a particular use case.
     included. This option can be used to specify the path to the
     ``ghcversions.h`` file to be included. This is primarily intended to be
     used by GHC's build system.
-


=====================================
libraries/base/GHC/Float.hs
=====================================
@@ -1387,7 +1387,7 @@ foreign import prim "stg_word64ToDoublezh"
 #endif
 
 
--- | @'castFloatToWord32' f@ does a bit-for-bit copy from a floating-point value
+-- | @'castFloatToWord64' f@ does a bit-for-bit copy from a floating-point value
 -- to an integral value.
 --
 -- @since 4.10.0.0


=====================================
testsuite/tests/parser/should_compile/T16619.hs
=====================================
@@ -0,0 +1,8 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS -Wmissing-space-after-bang #-}
+
+module T16619 where
+
+import T16619a
+
+1!2


=====================================
testsuite/tests/parser/should_compile/T16619a.hs
=====================================
@@ -0,0 +1,3 @@
+module T16619a where
+
+(!) _ _ = return []


=====================================
testsuite/tests/parser/should_compile/all.T
=====================================
@@ -142,3 +142,4 @@ test('T15457', normal, compile, [''])
 test('T15675', normal, compile, [''])
 test('T15781', normal, compile, [''])
 test('T16339', normal, compile, [''])
+test('T16619', [], multimod_compile, ['T16619', '-v0'])


=====================================
testsuite/tests/parser/should_fail/T15730.hs
=====================================
@@ -0,0 +1,3 @@
+module T15730 where
+
+x = 1 / {-# SCC ann #-} 2 / 2


=====================================
testsuite/tests/parser/should_fail/T15730.stderr
=====================================
@@ -0,0 +1,2 @@
+
+T15730.hs:3:27: error: parse error on input ‘/’


=====================================
testsuite/tests/parser/should_fail/all.T
=====================================
@@ -161,3 +161,4 @@ test('patFail006', normal, compile_fail, [''])
 test('patFail007', normal, compile_fail, [''])
 test('patFail008', normal, compile_fail, [''])
 test('patFail009', normal, compile_fail, [''])
+test('T15730', normal, compile_fail, [''])


=====================================
testsuite/tests/perf/compiler/T15164.hs
=====================================
@@ -252,7 +252,7 @@ instance Rule f Primary => Rule f Factor where
 --          ::= name
 newtype FormalDesignator = MkFormalDesignator (NT Name)
 instance Rule f Name => Rule f FormalDesignator where
-  get = trace "FormalDesignator" $ {-# SCC "get_FormalDesignator" #-} MkFormalDesignator <$> n93
+  get = trace "FormalDesignator" $ {-# SCC "get_FormalDesignator" #-} (MkFormalDesignator <$> n93)
 
 -- formal_part
 --          ::= formal_designator


=====================================
testsuite/tests/profiling/should_run/prof-doc-last.hs
=====================================
@@ -2,6 +2,6 @@ main :: IO ()
 main = do let xs = [1..1000000]
           let ys = [1..2000000]
           print $ {-# SCC "last_xs" #-} last xs
-          print $ {-# SCC "last_init_xs" #-} last $ init xs
+          print $ {-# SCC "last_init_xs" #-} last (init xs)
           print $ {-# SCC "last_ys" #-} last ys
-          print $ {-# SCC "last_init_ys" #-}last $ init ys
+          print $ {-# SCC "last_init_ys" #-} last (init ys)


=====================================
testsuite/tests/profiling/should_run/prof-doc-last.prof.sample
=====================================
@@ -8,7 +8,7 @@
 COST CENTRE  MODULE SRC                       %time %alloc
 
 main.ys      Main   prof-doc-last.hs:3:15-31   39.7   37.5
-last_init_ys Main   prof-doc-last.hs:7:45-58   23.1   29.2
+last_init_ys Main   prof-doc-last.hs:7:46-59   23.1   29.2
 main.xs      Main   prof-doc-last.hs:2:15-31   23.1   18.7
 last_init_xs Main   prof-doc-last.hs:5:46-59   11.6   14.6
 last_xs      Main   prof-doc-last.hs:4:41-47    1.7    0.0
@@ -27,7 +27,7 @@ MAIN           MAIN                  <built-in>                     46
  CAF           GHC.IO.Encoding.Iconv <entire-module>                65          0    0.0    0.0     0.0    0.0
  main          Main                  prof-doc-last.hs:(2,1)-(7,58)  93          0    0.0    0.0   100.0  100.0
   last_init_xs Main                  prof-doc-last.hs:5:46-59       96          1   11.6   14.6    11.6   14.6
-  last_init_ys Main                  prof-doc-last.hs:7:45-58       99          1   23.1   29.2    23.1   29.2
+  last_init_ys Main                  prof-doc-last.hs:7:46-59       99          1   23.1   29.2    23.1   29.2
   last_xs      Main                  prof-doc-last.hs:4:41-47       94          1    1.7    0.0     1.7    0.0
   last_ys      Main                  prof-doc-last.hs:6:41-47       97          1    0.8    0.0     0.8    0.0
   main.xs      Main                  prof-doc-last.hs:2:15-31       95          1   23.1   18.7    23.1   18.7



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/1ce224eef79feb2fe0942a9bf9070bfeb8fd6e5e...9fce97149961068cd566116a37d630f80bfb71f9

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/1ce224eef79feb2fe0942a9bf9070bfeb8fd6e5e...9fce97149961068cd566116a37d630f80bfb71f9
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20190506/927df8b4/attachment-0001.html>


More information about the ghc-commits mailing list