diff options
| author | Alan Zimmerman <alan.zimm@gmail.com> | 2020-10-06 18:38:35 +0100 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2020-10-21 14:48:28 -0400 |
| commit | 3e29ec51498dfe092b228889343dc8370ec0e64b (patch) | |
| tree | cb1112d9959afe43eff5d36097054886bd4fe524 /haddock-api/src/Haddock/GhcUtils.hs | |
| parent | 28b6b667a4f6cfb79d84ce48b6e4a1dd4592cc21 (diff) | |
Match GHC, adding IsUnicodeSyntax field to HsFunTy and HsScaled
(cherry picked from commit a7d1d8e034d25612d5d08ed8fdbf6f472aded4a1)
Diffstat (limited to 'haddock-api/src/Haddock/GhcUtils.hs')
| -rw-r--r-- | haddock-api/src/Haddock/GhcUtils.hs | 7 |
1 files changed, 4 insertions, 3 deletions
diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs index 3abb6481..8b4bcc05 100644 --- a/haddock-api/src/Haddock/GhcUtils.hs +++ b/haddock-api/src/Haddock/GhcUtils.hs @@ -42,6 +42,7 @@ import GHC.Types.Var.Env ( TyVarEnv, extendVarEnv, elemVarEnv, emptyVarEnv ) import GHC.Core.TyCo.Rep ( Type(..) ) import GHC.Core.Type ( isRuntimeRepVar ) import GHC.Builtin.Types( liftedRepDataConTyCon ) +import GHC.Parser.Annotation (IsUnicodeSyntax(..)) import GHC.Data.StringBuffer ( StringBuffer ) import qualified GHC.Data.StringBuffer as S @@ -165,13 +166,13 @@ getGADTConType (ConDeclGADT { con_forall = L _ has_forall | otherwise = tau_ty --- tau_ty :: LHsType DocNameI +-- tau_ty :: LHsType DocNameI tau_ty = case args of RecCon flds -> mkFunTy (noLoc (HsRecTy noExtField (unLoc flds))) res_ty PrefixCon pos_args -> foldr mkFunTy res_ty (map hsScaledThing pos_args) InfixCon arg1 arg2 -> (hsScaledThing arg1) `mkFunTy` ((hsScaledThing arg2) `mkFunTy` res_ty) - mkFunTy a b = noLoc (HsFunTy noExtField HsUnrestrictedArrow a b) + mkFunTy a b = noLoc (HsFunTy noExtField (HsUnrestrictedArrow NormalSyntax) a b) getGADTConType (ConDeclH98 {}) = panic "getGADTConType" -- Should only be called on ConDeclGADT @@ -227,7 +228,7 @@ getGADTConTypeG (ConDeclGADT { con_forall = L _ has_forall InfixCon arg1 arg2 -> (hsScaledThing arg1) `mkFunTy` ((hsScaledThing arg2) `mkFunTy` res_ty) -- mkFunTy :: LHsType DocNameI -> LHsType DocNameI -> LHsType DocNameI - mkFunTy a b = noLoc (HsFunTy noExtField HsUnrestrictedArrow a b) + mkFunTy a b = noLoc (HsFunTy noExtField (HsUnrestrictedArrow NormalSyntax) a b) getGADTConTypeG (ConDeclH98 {}) = panic "getGADTConTypeG" -- Should only be called on ConDeclGADT |