[commit: ghc] master: Retain AnnTilde in splitTildeApps (b407bd7)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/b407bd775d9241023b4694b3142a756df0082ea2/ghc

>---------------------------------------------------------------

commit b407bd775d9241023b4694b3142a756df0082ea2
Author: Alan Zimmerman <alan.zimm at gmail.com>
Date:   Tue Dec 22 12:35:22 2015 +0200

    Retain AnnTilde in splitTildeApps
    
    splitTildeApps can introduce a new HsAppInfix for a tilde, with a fresh
    SrcSpan, disconnecting its existing AnnTilde API Annotation.
    
    A tilde needs AnnTilde to render properly, this patch adds a new one on
    the fresh SrcSpan


>---------------------------------------------------------------

b407bd775d9241023b4694b3142a756df0082ea2
 compiler/parser/Parser.y    |  3 ++-
 compiler/parser/RdrHsSyn.hs | 21 +++++++++++++--------
 2 files changed, 15 insertions(+), 9 deletions(-)

diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index d6255a3..2b4e779 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -1652,7 +1652,8 @@ typedoc :: { LHsType RdrName }
 
 -- See Note [Parsing ~]
 btype :: { LHsType RdrName }
-        : tyapps                      { sL1 $1 $ HsAppsTy (splitTildeApps (reverse (unLoc $1))) }
+        : tyapps                      {%  splitTildeApps (reverse (unLoc $1)) >>=
+                                          \ts -> return $ sL1 $1 $ HsAppsTy ts }
 
 -- Used for parsing Haskell98-style data constructors,
 -- in order to forbid the blasphemous
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index c3c356a..222641b 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -93,6 +93,7 @@ import Util
 import ApiAnnotation
 import Data.List
 import qualified GHC.LanguageExtensions as LangExt
+import MonadUtils
 
 #if __GLASGOW_HASKELL__ < 709
 import Control.Applicative ((<$>))
@@ -1071,21 +1072,25 @@ splitTilde t = go t
 
 -- | Transform tyapps with strict_marks into uses of twiddle
 -- [~a, ~b, c, ~d] ==> (~a) ~ b c ~ d
-splitTildeApps :: [LHsAppType RdrName] -> [LHsAppType RdrName]
-splitTildeApps []         = []
-splitTildeApps (t : rest) = t : concatMap go rest
+splitTildeApps :: [LHsAppType RdrName] -> P [LHsAppType RdrName]
+splitTildeApps []         = return []
+splitTildeApps (t : rest) = do
+  rest' <- concatMapM go rest
+  return (t : rest')
   where go (L l (HsAppPrefix
             (L loc (HsBangTy
                     (HsSrcBang Nothing NoSrcUnpack SrcLazy)
                     ty))))
-          = [L tilde_loc (HsAppInfix (L tilde_loc eqTyCon_RDR)),
-             L l (HsAppPrefix ty)]
-             -- NOTE: no annotation is attached to an HsAppPrefix, so the
-             --       surrounding SrcSpan is not critical
+          = addAnnotation l AnnTilde l >>
+            return
+              [L tilde_loc (HsAppInfix (L tilde_loc eqTyCon_RDR)),
+               L l (HsAppPrefix ty)]
+               -- NOTE: no annotation is attached to an HsAppPrefix, so the
+               --       surrounding SrcSpan is not critical
           where
             tilde_loc = srcSpanFirstCharacter loc
 
-        go t = [t]
+        go t = return [t]