API Annotations: Keep track of unicode for linear arrow notationwip/az/unicode-hsscaled

The linear arrow can be parsed as `%1 ->` or a direct single token unicode
equivalent.

Make sure that this distinction is captured in the parsed AST by using
IsUnicodeSyntax where it appears, and introduce a new API Annotation,
AnnMult to represent its location when unicode is not used.

Updated haddock submodule

20 files changed, 107 insertions, 76 deletions

diff --git a/compiler/GHC/Hs/Type.hs b/compiler/GHC/Hs/Type.hs
index 4fc2580aba..2e9f7b60c1 100644
--- a/compiler/GHC/Hs/Type.hs
+++ b/compiler/GHC/Hs/Type.hs
@@ -931,22 +931,23 @@ isUnrestricted _ = False
 
 -- | Denotes the type of arrows in the surface language
 data HsArrow pass
-  = HsUnrestrictedArrow
-    -- ^ a -> b
-  | HsLinearArrow
-    -- ^ a %1 -> b
-  | HsExplicitMult (LHsType pass)
-    -- ^ a %m -> b (very much including `a %Many -> b`! This is how the
-    -- programmer wrote it). It is stored as an `HsType` so as to preserve the
-    -- syntax as written in the program.
+  = HsUnrestrictedArrow IsUnicodeSyntax
+    -- ^ a -> b or a → b
+  | HsLinearArrow IsUnicodeSyntax
+    -- ^ a %1 -> b or a %1 → b, or a ⊸ b
+  | HsExplicitMult IsUnicodeSyntax (LHsType pass)
+    -- ^ a %m -> b or a %m → b (very much including `a %Many -> b`!
+    -- This is how the programmer wrote it). It is stored as an
+    -- `HsType` so as to preserve the syntax as written in the
+    -- program.
 
 -- | Convert an arrow into its corresponding multiplicity. In essence this
 -- erases the information of whether the programmer wrote an explicit
 -- multiplicity or a shorthand.
 arrowToHsType :: HsArrow GhcRn -> LHsType GhcRn
-arrowToHsType HsUnrestrictedArrow = noLoc manyDataConHsTy
-arrowToHsType HsLinearArrow = noLoc oneDataConHsTy
-arrowToHsType (HsExplicitMult p) = p
+arrowToHsType (HsUnrestrictedArrow _) = noLoc manyDataConHsTy
+arrowToHsType (HsLinearArrow _) = noLoc oneDataConHsTy
+arrowToHsType (HsExplicitMult _ p) = p
 
 -- | This is used in the syntax. In constructor declaration. It must keep the
 -- arrow representation.
@@ -961,20 +962,23 @@ hsScaledThing (HsScaled _ t) = t
 -- | When creating syntax we use the shorthands. It's better for printing, also,
 -- the shorthands work trivially at each pass.
 hsUnrestricted, hsLinear :: a -> HsScaled pass a
-hsUnrestricted = HsScaled HsUnrestrictedArrow
-hsLinear = HsScaled HsLinearArrow
+hsUnrestricted = HsScaled (HsUnrestrictedArrow NormalSyntax)
+hsLinear = HsScaled (HsLinearArrow NormalSyntax)
 
 instance Outputable a => Outputable (HsScaled pass a) where
    ppr (HsScaled _cnt t) = -- ppr cnt <> ppr t
-                          ppr t
+                            ppr t
 
 instance
       (OutputableBndrId pass) =>
       Outputable (HsArrow (GhcPass pass)) where
-  ppr HsUnrestrictedArrow = parens arrow
-  ppr HsLinearArrow = parens lollipop
-  ppr (HsExplicitMult p) = parens (mulArrow (ppr p))
+  ppr arr = parens (pprHsArrow arr)
 
+-- See #18846
+pprHsArrow :: (OutputableBndrId pass) => HsArrow (GhcPass pass) -> SDoc
+pprHsArrow (HsUnrestrictedArrow _) = arrow
+pprHsArrow (HsLinearArrow _) = lollipop
+pprHsArrow (HsExplicitMult _ p) = (mulArrow (ppr p))
 
 {-
 Note [Unit tuples]
@@ -1959,10 +1963,7 @@ ppr_fun_ty :: (OutputableBndrId p)
 ppr_fun_ty mult ty1 ty2
   = let p1 = ppr_mono_lty ty1
         p2 = ppr_mono_lty ty2
-        arr = case mult of
-          HsLinearArrow -> lollipop
-          HsUnrestrictedArrow -> arrow
-          HsExplicitMult p -> mulArrow (ppr p)
+        arr = pprHsArrow mult
     in
     sep [p1, arr <+> p2]
 
diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs
index 9976334956..c1edb7ef3e 100644
--- a/compiler/GHC/Hs/Utils.hs
+++ b/compiler/GHC/Hs/Utils.hs
@@ -133,6 +133,7 @@ import GHC.Types.SrcLoc
 import GHC.Data.FastString
 import GHC.Data.Bag
 import GHC.Settings.Constants
+import GHC.Parser.Annotation
 
 import GHC.Utils.Misc
 import GHC.Utils.Outputable
@@ -538,12 +539,12 @@ nlList exprs          = noLoc (ExplicitList noExtField Nothing exprs)
 
 nlHsAppTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
 nlHsTyVar :: IdP (GhcPass p)                            -> LHsType (GhcPass p)
-nlHsFunTy :: HsArrow (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
+nlHsFunTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
 nlHsParTy :: LHsType (GhcPass p)                        -> LHsType (GhcPass p)
 
 nlHsAppTy f t = noLoc (HsAppTy noExtField f (parenthesizeHsType appPrec t))
 nlHsTyVar x   = noLoc (HsTyVar noExtField NotPromoted (noLoc x))
-nlHsFunTy mult a b = noLoc (HsFunTy noExtField mult (parenthesizeHsType funPrec a) b)
+nlHsFunTy a b = noLoc (HsFunTy noExtField (HsUnrestrictedArrow NormalSyntax) (parenthesizeHsType funPrec a) b)
 nlHsParTy t   = noLoc (HsParTy noExtField t)
 
 nlHsTyConApp :: LexicalFixity -> IdP (GhcPass p)
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index b688b86310..666b329e84 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -2051,22 +2051,22 @@ is connected to the first type too.
 type :: { LHsType GhcPs }
         -- See Note [%shift: type -> btype]
         : btype %shift                 { $1 }
-        | btype '->' ctype             {% ams $1 [mu AnnRarrow $2] -- See note [GADT decl discards annotations]
-                                       >> ams (sLL $1 $> $ HsFunTy noExtField HsUnrestrictedArrow $1 $3)
+        | btype '->' ctype             {% ams $1 [mu AnnRarrow $2] -- See Note [GADT decl discards annotations]
+                                       >> ams (sLL $1 $> $ HsFunTy noExtField (HsUnrestrictedArrow (toUnicode $2)) $1 $3)
                                               [mu AnnRarrow $2] }
 
         | btype mult '->' ctype        {% hintLinear (getLoc $2)
-                                       >> ams $1 [mu AnnRarrow $3] -- See note [GADT decl discards annotations]
-                                       >> ams (sLL $1 $> $ HsFunTy noExtField (unLoc $2) $1 $4)
-                                              [mu AnnRarrow $3] }
+                                       >> ams $1 [mj AnnMult $2,mu AnnRarrow $3] -- See Note [GADT decl discards annotations]
+                                       >> ams (sLL $1 $> $ HsFunTy noExtField ((unLoc $2) (toUnicode $3)) $1 $4)
+                                              [mj AnnMult $2,mu AnnRarrow $3] }
 
         | btype '->.' ctype            {% hintLinear (getLoc $2)
-                                       >> ams $1 [mu AnnLollyU $2] -- See note [GADT decl discards annotations]
-                                       >> ams (sLL $1 $> $ HsFunTy noExtField HsLinearArrow $1 $3)
+                                       >> ams $1 [mu AnnLollyU $2] -- See Note [GADT decl discards annotations]
+                                       >> ams (sLL $1 $> $ HsFunTy noExtField (HsLinearArrow UnicodeSyntax) $1 $3)
                                               [mu AnnLollyU $2] }
 
-mult :: { Located (HsArrow GhcPs) }
-        : PREFIX_PERCENT atype          { sLL $1 $> (mkMultTy $2) }
+mult :: { Located (IsUnicodeSyntax -> HsArrow GhcPs) }
+        : PREFIX_PERCENT atype          { sLL $1 $> (\u -> mkMultTy u $2) }
 
 btype :: { LHsType GhcPs }
         : infixtype                     {% runPV $1 }
@@ -3999,6 +3999,9 @@ mu a lt@(L l t) = AddAnn (toUnicodeAnn a lt) l
 toUnicodeAnn :: AnnKeywordId -> Located Token -> AnnKeywordId
 toUnicodeAnn a t = if isUnicode t then unicodeAnn a else a
 
+toUnicode :: Located Token -> IsUnicodeSyntax
+toUnicode t = if isUnicode t then UnicodeSyntax else NormalSyntax
+
 gl :: Located a -> SrcSpan
 gl = getLoc
 
diff --git a/compiler/GHC/Parser/Annotation.hs b/compiler/GHC/Parser/Annotation.hs
index 0cbf44296f..a3cbc92308 100644
--- a/compiler/GHC/Parser/Annotation.hs
+++ b/compiler/GHC/Parser/Annotation.hs
@@ -301,6 +301,7 @@ data AnnKeywordId
     | AnnMdo
     | AnnMinus -- ^ '-'
     | AnnModule
+    | AnnMult -- ^ '%1'
     | AnnNewtype
     | AnnName -- ^ where a name loses its location in the AST, this carries it
     | AnnOf
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index ed11a4df18..4812486d19 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -2617,9 +2617,9 @@ mkLHsOpTy x op y =
   let loc = getLoc x `combineSrcSpans` getLoc op `combineSrcSpans` getLoc y
   in L loc (mkHsOpTy x op y)
 
-mkMultTy :: LHsType GhcPs -> HsArrow GhcPs
-mkMultTy (L _ (HsTyLit _ (HsNumTy _ 1))) = HsLinearArrow
-mkMultTy t = HsExplicitMult t
+mkMultTy :: IsUnicodeSyntax -> LHsType GhcPs -> HsArrow GhcPs
+mkMultTy u (L _ (HsTyLit _ (HsNumTy _ 1))) = HsLinearArrow u
+mkMultTy u t = HsExplicitMult u t
 
 -----------------------------------------------------------------------------
 -- Token symbols
diff --git a/compiler/GHC/Parser/PostProcess/Haddock.hs b/compiler/GHC/Parser/PostProcess/Haddock.hs
index 849e2acdea..7959db5a7c 100644
--- a/compiler/GHC/Parser/PostProcess/Haddock.hs
+++ b/compiler/GHC/Parser/PostProcess/Haddock.hs
@@ -980,10 +980,10 @@ instance HasHaddock (Located (HsType GhcPs)) where
         pure $ L l (HsQualTy noExtField lhs rhs')
 
       -- arg -> res
-      HsFunTy _ mult lhs rhs -> do
+      HsFunTy u mult lhs rhs -> do
         lhs' <- addHaddock lhs
         rhs' <- addHaddock rhs
-        pure $ L l (HsFunTy noExtField mult lhs' rhs')
+        pure $ L l (HsFunTy u mult lhs' rhs')
 
       -- other types
       _ -> liftHdkA $ do
diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs
index 77ece61c14..e04846ddde 100644
--- a/compiler/GHC/Rename/HsType.hs
+++ b/compiler/GHC/Rename/HsType.hs
@@ -624,11 +624,11 @@ rnHsTyKi env ty@(HsRecTy _ flds)
                                    2 (ppr ty))
            ; return [] }
 
-rnHsTyKi env (HsFunTy _ mult ty1 ty2)
+rnHsTyKi env (HsFunTy u mult ty1 ty2)
   = do { (ty1', fvs1) <- rnLHsTyKi env ty1
        ; (ty2', fvs2) <- rnLHsTyKi env ty2
        ; (mult', w_fvs) <- rnHsArrow env mult
-       ; return (HsFunTy noExtField mult' ty1' ty2'
+       ; return (HsFunTy u mult' ty1' ty2'
                 , plusFVs [fvs1, fvs2, w_fvs]) }
 
 rnHsTyKi env listTy@(HsListTy _ ty)
@@ -721,10 +721,10 @@ rnHsTyKi env (HsWildCardTy _)
        ; return (HsWildCardTy noExtField, emptyFVs) }
 
 rnHsArrow :: RnTyKiEnv -> HsArrow GhcPs -> RnM (HsArrow GhcRn, FreeVars)
-rnHsArrow _env HsUnrestrictedArrow = return (HsUnrestrictedArrow, emptyFVs)
-rnHsArrow _env HsLinearArrow = return (HsLinearArrow, emptyFVs)
-rnHsArrow env (HsExplicitMult p)
-  = (\(mult, fvs) -> (HsExplicitMult mult, fvs)) <$> rnLHsTyKi env p
+rnHsArrow _env (HsUnrestrictedArrow u) = return (HsUnrestrictedArrow u, emptyFVs)
+rnHsArrow _env (HsLinearArrow u) = return (HsLinearArrow u, emptyFVs)
+rnHsArrow env (HsExplicitMult u p)
+  = (\(mult, fvs) -> (HsExplicitMult u mult, fvs)) <$> rnLHsTyKi env p
 
 --------------
 rnTyVar :: RnTyKiEnv -> RdrName -> RnM Name
@@ -1847,7 +1847,7 @@ extract_lty (L _ ty) acc
 
 extract_hs_arrow :: HsArrow GhcPs -> FreeKiTyVars ->
                    FreeKiTyVars
-extract_hs_arrow (HsExplicitMult p) acc = extract_lty p acc
+extract_hs_arrow (HsExplicitMult _ p) acc = extract_lty p acc
 extract_hs_arrow _ acc = acc
 
 extract_hs_for_all_telescope :: HsForAllTelescope GhcPs
diff --git a/compiler/GHC/Tc/Gen/HsType.hs b/compiler/GHC/Tc/Gen/HsType.hs
index eb1f4f6a7c..e599ad56f8 100644
--- a/compiler/GHC/Tc/Gen/HsType.hs
+++ b/compiler/GHC/Tc/Gen/HsType.hs
@@ -116,6 +116,7 @@ import GHC.Data.FastString
 import GHC.Builtin.Names hiding ( wildCardName )
 import GHC.Driver.Session
 import qualified GHC.LanguageExtensions as LangExt
+import GHC.Parser.Annotation
 
 import GHC.Data.Maybe
 import GHC.Data.Bag( unitBag )
@@ -1046,7 +1047,7 @@ tc_hs_type mode (HsFunTy _ mult ty1 ty2) exp_kind
 
 tc_hs_type mode (HsOpTy _ ty1 (L _ op) ty2) exp_kind
   | op `hasKey` funTyConKey
-  = tc_fun_type mode HsUnrestrictedArrow ty1 ty2 exp_kind
+  = tc_fun_type mode (HsUnrestrictedArrow NormalSyntax) ty1 ty2 exp_kind
 
 --------- Foralls
 tc_hs_type mode forall@(HsForAllTy { hst_tele = tele, hst_body = ty }) exp_kind
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index 2b583cd6a4..37b399bdd1 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -2453,7 +2453,7 @@ getGhciStepIO = do
                      { hst_tele = mkHsForAllInvisTele
                                   [noLoc $ UserTyVar noExtField SpecifiedSpec (noLoc a_tv)]
                      , hst_xforall = noExtField
-                     , hst_body  = nlHsFunTy HsUnrestrictedArrow ghciM ioM }
+                     , hst_body  = nlHsFunTy ghciM ioM }
 
         stepTy :: LHsSigWcType GhcRn
         stepTy = mkEmptyWildCardBndrs (mkEmptyImplicitBndrs step_ty)
diff --git a/compiler/GHC/Tc/TyCl.hs b/compiler/GHC/Tc/TyCl.hs
index 28d3651876..bd47bf7bd9 100644
--- a/compiler/GHC/Tc/TyCl.hs
+++ b/compiler/GHC/Tc/TyCl.hs
@@ -3416,7 +3416,7 @@ tcConArg exp_kind (HsScaled w bty)
         ; return (Scaled w' arg_ty, getBangStrictness bty) }
 
 tcDataConMult :: HsArrow GhcRn -> TcM Mult
-tcDataConMult arr@HsUnrestrictedArrow = do
+tcDataConMult arr@(HsUnrestrictedArrow _) = do
   -- See Note [Function arrows in GADT constructors]
   linearEnabled <- xoptM LangExt.LinearTypes
   if linearEnabled then tcMult arr else return oneDataConTy
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index 792b3614c3..83ffbaa831 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -51,6 +51,7 @@ import GHC.Utils.Misc
 import GHC.Data.FastString
 import GHC.Utils.Outputable as Outputable
 import GHC.Utils.Panic
+import GHC.Parser.Annotation
 
 import qualified Data.ByteString as BS
 import Control.Monad( unless, ap )
@@ -1471,7 +1472,7 @@ cvtTypeKind ty_str ty
                           _            -> return $
                                           parenthesizeHsType sigPrec x'
                  let y'' = parenthesizeHsType sigPrec y'
-                 returnL (HsFunTy noExtField HsUnrestrictedArrow x'' y'')
+                 returnL (HsFunTy noExtField (HsUnrestrictedArrow NormalSyntax) x'' y'')
              | otherwise
              -> mk_apps
                 (HsTyVar noExtField NotPromoted (noLoc (getRdrName unrestrictedFunTyCon)))
@@ -1623,9 +1624,9 @@ cvtTypeKind ty_str ty
 hsTypeToArrow :: LHsType GhcPs -> HsArrow GhcPs
 hsTypeToArrow w = case unLoc w of
                      HsTyVar _ _ (L _ (isExact_maybe -> Just n))
-                        | n == oneDataConName -> HsLinearArrow
-                        | n == manyDataConName -> HsUnrestrictedArrow
-                     _ -> HsExplicitMult w
+                        | n == oneDataConName -> HsLinearArrow NormalSyntax
+                        | n == manyDataConName -> HsUnrestrictedArrow NormalSyntax
+                     _ -> HsExplicitMult NormalSyntax w
 
 -- ConT/InfixT can contain both data constructor (i.e., promoted) names and
 -- other (i.e, unpromoted) names, as opposed to PromotedT, which can only
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 029b39ba42..ac96def464 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -1683,7 +1683,7 @@ defineMacro overwrite s = do
           ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy
           body = nlHsVar compose_RDR `mkHsApp` (nlHsPar step)
                                      `mkHsApp` (nlHsPar expr)
-          tySig = mkLHsSigWcType (nlHsFunTy HsUnrestrictedArrow stringTy ioM)
+          tySig = mkLHsSigWcType (nlHsFunTy stringTy ioM)
           new_expr = L (getLoc expr) $ ExprWithTySig noExtField body tySig
       hv <- GHC.compileParsedExprRemote new_expr
 
@@ -1751,7 +1751,7 @@ getGhciStepIO = do
       ghciM = nlHsTyVar (getRdrName ghciTyConName) `nlHsAppTy` stringTy
       ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy
       body = nlHsVar (getRdrName ghciStepIoMName)
-      tySig = mkLHsSigWcType (nlHsFunTy HsUnrestrictedArrow ghciM ioM)
+      tySig = mkLHsSigWcType (nlHsFunTy ghciM ioM)
   return $ noLoc $ ExprWithTySig noExtField body tySig
 
 -----------------------------------------------------------------------------
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
index 118500cdeb..9af02d8c66 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
@@ -44,7 +44,8 @@
           ({ T17544.hs:6:9-16 }
            (HsFunTy
             (NoExtField)
-            (HsUnrestrictedArrow)
+            (HsUnrestrictedArrow
+             (NormalSyntax))
             ({ T17544.hs:6:9 }
              (HsTyVar
               (NoExtField)
@@ -104,7 +105,8 @@
           ({ T17544.hs:10:9-16 }
            (HsFunTy
             (NoExtField)
-            (HsUnrestrictedArrow)
+            (HsUnrestrictedArrow
+             (NormalSyntax))
             ({ T17544.hs:10:9 }
              (HsTyVar
               (NoExtField)
@@ -161,7 +163,8 @@
           ({ T17544.hs:14:9-16 }
            (HsFunTy
             (NoExtField)
-            (HsUnrestrictedArrow)
+            (HsUnrestrictedArrow
+             (NormalSyntax))
             ({ T17544.hs:14:9 }
              (HsTyVar
               (NoExtField)
@@ -221,7 +224,8 @@
           ({ T17544.hs:18:9-16 }
            (HsFunTy
             (NoExtField)
-            (HsUnrestrictedArrow)
+            (HsUnrestrictedArrow
+             (NormalSyntax))
             ({ T17544.hs:18:9 }
              (HsTyVar
               (NoExtField)
@@ -248,7 +252,8 @@
           ({ T17544.hs:20:9-16 }
            (HsFunTy
             (NoExtField)
-            (HsUnrestrictedArrow)
+            (HsUnrestrictedArrow
+             (NormalSyntax))
             ({ T17544.hs:20:9 }
              (HsTyVar
               (NoExtField)
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
index 2681ca9fb9..ccba2caf27 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
@@ -85,7 +85,8 @@
           (Nothing)
           (PrefixCon
            [(HsScaled
-             (HsUnrestrictedArrow)
+             (HsUnrestrictedArrow
+              (NormalSyntax))
              ({ T17544_kw.hs:19:18-19 }
               (HsTupleTy
                (NoExtField)
diff --git a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
index 5a6c569ad3..dc48459d17 100644
--- a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
@@ -66,7 +66,8 @@
           (Nothing)
           (PrefixCon
            [(HsScaled
-             (HsLinearArrow)
+             (HsLinearArrow
+              (NormalSyntax))
              ({ DumpParsedAst.hs:7:26-30 }
               (HsTyVar
                (NoExtField)
@@ -258,7 +259,8 @@
           (Nothing)
           (PrefixCon
            [(HsScaled
-             (HsLinearArrow)
+             (HsLinearArrow
+              (NormalSyntax))
              ({ DumpParsedAst.hs:14:25-29 }
               (HsParTy
                (NoExtField)
@@ -392,7 +394,8 @@
            ({ DumpParsedAst.hs:16:31-39 }
             (HsFunTy
              (NoExtField)
-             (HsUnrestrictedArrow)
+             (HsUnrestrictedArrow
+              (NormalSyntax))
              ({ DumpParsedAst.hs:16:31 }
               (HsTyVar
                (NoExtField)
diff --git a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
index 4b5c58d43b..599d369ff5 100644
--- a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
@@ -100,7 +100,8 @@
             (Nothing)
             (PrefixCon
              [(HsScaled
-               (HsLinearArrow)
+               (HsLinearArrow
+                (NormalSyntax))
                ({ DumpRenamedAst.hs:9:26-30 }
                 (HsTyVar
                  (NoExtField)
@@ -254,7 +255,8 @@
            ({ DumpRenamedAst.hs:15:20-33 }
             (HsFunTy
              (NoExtField)
-             (HsUnrestrictedArrow)
+             (HsUnrestrictedArrow
+              (NormalSyntax))
              ({ DumpRenamedAst.hs:15:20 }
               (HsTyVar
                (NoExtField)
@@ -264,7 +266,8 @@
              ({ DumpRenamedAst.hs:15:25-33 }
               (HsFunTy
                (NoExtField)
-               (HsUnrestrictedArrow)
+               (HsUnrestrictedArrow
+                (NormalSyntax))
                ({ DumpRenamedAst.hs:15:25 }
                 (HsTyVar
                  (NoExtField)
@@ -308,7 +311,8 @@
                  ({ DumpRenamedAst.hs:18:28-36 }
                   (HsFunTy
                    (NoExtField)
-                   (HsUnrestrictedArrow)
+                   (HsUnrestrictedArrow
+                    (NormalSyntax))
                    ({ DumpRenamedAst.hs:18:28 }
                     (HsTyVar
                      (NoExtField)
@@ -332,14 +336,16 @@
              ({ DumpRenamedAst.hs:18:42-60 }
               (HsFunTy
                (NoExtField)
-               (HsUnrestrictedArrow)
+               (HsUnrestrictedArrow
+                (NormalSyntax))
                ({ DumpRenamedAst.hs:18:42-52 }
                 (HsParTy
                  (NoExtField)
                  ({ DumpRenamedAst.hs:18:43-51 }
                   (HsFunTy
                    (NoExtField)
-                   (HsUnrestrictedArrow)
+                   (HsUnrestrictedArrow
+                    (NormalSyntax))
                    ({ DumpRenamedAst.hs:18:43 }
                     (HsTyVar
                      (NoExtField)
@@ -370,7 +376,8 @@
                (Nothing)
                (PrefixCon
                 [(HsScaled
-                  (HsUnrestrictedArrow)
+                  (HsUnrestrictedArrow
+                   (NormalSyntax))
                   ({ DumpRenamedAst.hs:19:10-34 }
                    (HsParTy
                     (NoExtField)
@@ -388,7 +395,8 @@
                       ({ DumpRenamedAst.hs:19:22-33 }
                        (HsFunTy
                         (NoExtField)
-                        (HsUnrestrictedArrow)
+                        (HsUnrestrictedArrow
+                         (NormalSyntax))
                         ({ DumpRenamedAst.hs:19:22-25 }
                          (HsAppTy
                           (NoExtField)
@@ -496,7 +504,8 @@
             (Nothing)
             (PrefixCon
              [(HsScaled
-               (HsLinearArrow)
+               (HsLinearArrow
+                (NormalSyntax))
                ({ DumpRenamedAst.hs:21:25-29 }
                 (HsParTy
                  (NoExtField)
@@ -620,7 +629,8 @@
              ({ DumpRenamedAst.hs:23:31-39 }
               (HsFunTy
                (NoExtField)
-               (HsUnrestrictedArrow)
+               (HsUnrestrictedArrow
+                (NormalSyntax))
                ({ DumpRenamedAst.hs:23:31 }
                 (HsTyVar
                  (NoExtField)
diff --git a/testsuite/tests/parser/should_compile/KindSigs.stderr b/testsuite/tests/parser/should_compile/KindSigs.stderr
index c5976593d3..13aa2e6147 100644
--- a/testsuite/tests/parser/should_compile/KindSigs.stderr
+++ b/testsuite/tests/parser/should_compile/KindSigs.stderr
@@ -276,7 +276,8 @@
         ({ KindSigs.hs:22:8-44 }
          (HsFunTy
           (NoExtField)
-          (HsUnrestrictedArrow)
+          (HsUnrestrictedArrow
+           (NormalSyntax))
           ({ KindSigs.hs:22:8-20 }
            (HsParTy
             (NoExtField)
@@ -300,7 +301,8 @@
           ({ KindSigs.hs:22:25-44 }
            (HsFunTy
             (NoExtField)
-            (HsUnrestrictedArrow)
+            (HsUnrestrictedArrow
+             (NormalSyntax))
             ({ KindSigs.hs:22:25-28 }
              (HsTyVar
               (NoExtField)
diff --git a/testsuite/tests/parser/should_compile/T14189.stderr b/testsuite/tests/parser/should_compile/T14189.stderr
index f794049568..32ae85e4dc 100644
--- a/testsuite/tests/parser/should_compile/T14189.stderr
+++ b/testsuite/tests/parser/should_compile/T14189.stderr
@@ -42,7 +42,8 @@
             (Nothing)
             (PrefixCon
              [(HsScaled
-               (HsLinearArrow)
+               (HsLinearArrow
+                (NormalSyntax))
                ({ T14189.hs:6:18-20 }
                 (HsTyVar
                  (NoExtField)
diff --git a/testsuite/tests/printer/T18791.stderr b/testsuite/tests/printer/T18791.stderr
index 00f8efc801..09aee04678 100644
--- a/testsuite/tests/printer/T18791.stderr
+++ b/testsuite/tests/printer/T18791.stderr
@@ -41,7 +41,8 @@
           (Nothing)
           (PrefixCon
            [(HsScaled
-             (HsUnrestrictedArrow)
+             (HsUnrestrictedArrow
+              (NormalSyntax))
              ({ T18791.hs:5:10-12 }
               (HsTyVar
                (NoExtField)
diff --git a/utils/haddock b/utils/haddock
-Subproject 77261e89c31b41eb5d7f1d16bb1de5b14b4296f
+Subproject a7d1d8e034d25612d5d08ed8fdbf6f472aded4a