[GHC] #13088: Type operator holes don't work infix
GHC
ghc-devs at haskell.org
Sun Jan 8 17:53:12 UTC 2017
#13088: Type operator holes don't work infix
-------------------------------------+-------------------------------------
Reporter: RyanGlScott | Owner:
Type: bug | Status: new
Priority: normal | Milestone:
Component: Compiler | Version: 8.0.1
(Parser) |
Resolution: | Keywords:
Operating System: Unknown/Multiple | Architecture:
Type of failure: GHC rejects | Unknown/Multiple
valid program | Test Case:
Blocked By: | Blocking:
Related Tickets: #13050 | Differential Rev(s):
Wiki Page: |
-------------------------------------+-------------------------------------
Description changed by RyanGlScott:
@@ -3,2 +3,0 @@
-
- Does this also work with TypeOperators? That is, you can do this:
New description:
Originally noted in https://phabricator.haskell.org/D2910 (which fixed
#13050). Currently, you can do this:
{{{#!hs
{-# LANGUAGE TypeOperators #-}
foo :: a `_over` b -> _over a b
foo = id
}}}
But not this:
{{{#!hs
{-# LANGUAGE TypeOperators #-}
foo :: a `_` b -> over a b
foo = id
}}}
osa1 made an attempt at fixing this, and recorded his progress
[https://phabricator.haskell.org/D2910#85423 here]:
> I played with alternative implementations and attempted at implementing
type-level version of this patch as suggested by @RyanGlScott.
>
> Since `_` needs special treatment by the renamer I think we have to have
some kind of special treatment for `_` in the parser too, so this
implementation may not be too bad.
>
> (alternatively I guess we could remove special treatment for `_` in the
parser but that'd just move special cases to the renamer, so I'm not sure
that's any better than the current approach)
>
> About the type-level named infix holes: Type renamer is quite different
than term renamer (`RnTypes.hs`) and I don't understand type-checker parts
of the compiler -- but I was able to made an attempt at implementing this
>
> {{{#!diff
> diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs
> index 53f200f..877c243 100644
> --- a/compiler/hsSyn/HsTypes.hs
> +++ b/compiler/hsSyn/HsTypes.hs
> @@ -608,6 +608,7 @@ type LHsAppType name = Located (HsAppType name)
> data HsAppType name
> = HsAppInfix (Located name) -- either a symbol or an id in
backticks
> | HsAppPrefix (LHsType name) -- anything else, including things
like (+)
> + | HsAppWild (Located (HsWildCardInfo name))
> deriving instance (DataId name) => Data (HsAppType name)
>
> instance (OutputableBndrId name) => Outputable (HsAppType name) where
> @@ -987,11 +988,18 @@ getAppsTyHead_maybe tys = case splitHsAppsTy tys
of
> splitHsAppsTy :: [LHsAppType name] -> ([[LHsType name]], [Located
name])
> splitHsAppsTy = go [] [] []
> where
> + go :: [LHsType name]
> + -> [[LHsType name]]
> + -> [Located name]
> + -> [LHsAppType name]
> + -> ([[LHsType name]], [Located name])
> go acc acc_non acc_sym [] = (reverse (reverse acc : acc_non),
reverse acc_sym)
> go acc acc_non acc_sym (L _ (HsAppPrefix ty) : rest)
> = go (ty : acc) acc_non acc_sym rest
> go acc acc_non acc_sym (L _ (HsAppInfix op) : rest)
> = go [] (reverse acc : acc_non) (op : acc_sym) rest
> + go acc acc_non acc_sym (L l (HsAppWild (L _ wc)) : rest)
> + = go (L l (HsWildCardTy wc) : acc) acc_non acc_sym rest
>
> -- Retrieve the name of the "head" of a nested type application
> -- somewhat like splitHsAppTys, but a little more thorough
> @@ -1334,14 +1342,18 @@ ppr_fun_ty ctxt_prec ty1 ty2
>
> --------------------------
> ppr_app_ty :: (OutputableBndrId name) => TyPrec -> HsAppType name ->
SDoc
> -ppr_app_ty _ (HsAppInfix (L _ n)) = pprInfixOcc n
> +ppr_app_ty _ (HsAppInfix (L _ n))
> + = pprInfixOcc n
> ppr_app_ty _ (HsAppPrefix (L _ (HsTyVar NotPromoted (L _ n))))
> = pprPrefixOcc n
> ppr_app_ty _ (HsAppPrefix (L _ (HsTyVar Promoted (L _ n))))
> = space <> quote (pprPrefixOcc n) -- We need a space before the '
above, so
> -- the parser does not attach it to
the
> -- previous symbol
> -ppr_app_ty ctxt (HsAppPrefix ty) = ppr_mono_lty
ctxt ty
> +ppr_app_ty ctxt (HsAppPrefix ty)
> + = ppr_mono_lty ctxt ty
> +ppr_app_ty ctxt (HsAppWild (L _ (AnonWildCard _)))
> + = empty -- FIXME
>
> --------------------------
> ppr_tylit :: HsTyLit -> SDoc
> diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
> index dfb6755..da4696a 100644
> --- a/compiler/parser/Parser.y
> +++ b/compiler/parser/Parser.y
> @@ -1833,6 +1833,7 @@ tyapp :: { LHsAppType RdrName }
> [mj AnnSimpleQuote $1] }
> | SIMPLEQUOTE varop {% ams (sLL $1 $> $ HsAppInfix
$2)
> [mj AnnSimpleQuote $1] }
> + | '`' '_' '`' { sL1 $1 (HsAppWild (sL1 $1
(AnonWildCard PlaceHolder))) }
>
> atype :: { LHsType RdrName }
> : ntgtycon { sL1 $1 (HsTyVar NotPromoted
$1) } -- Not including unit tuples
> diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs
> index f3fcf88..9298020 100644
> --- a/compiler/rename/RnTypes.hs
> +++ b/compiler/rename/RnTypes.hs
> @@ -1050,8 +1050,11 @@ collectAnonWildCards lty = go lty
>
> gos = mconcat . map go
>
> + prefix_types_only :: HsAppType Name -> Maybe (LHsType Name)
> prefix_types_only (HsAppPrefix ty) = Just ty
> prefix_types_only (HsAppInfix _) = Nothing
> + prefix_types_only (HsAppWild (L l (AnonWildCard wc_name))) =
> + Just (L l (HsWildCardTy (AnonWildCard wc_name)))
>
> collectAnonWildCardsBndrs :: [LHsTyVarBndr Name] -> [Name]
> collectAnonWildCardsBndrs ltvs = concatMap (go . unLoc) ltvs
> @@ -1646,8 +1649,9 @@ extract_apps t_or_k tys acc = foldrM (extract_app
t_or_k) acc tys
>
> extract_app :: TypeOrKind -> LHsAppType RdrName -> FreeKiTyVars
> -> RnM FreeKiTyVars
> -extract_app t_or_k (L _ (HsAppInfix tv)) acc = extract_tv t_or_k tv
acc
> -extract_app t_or_k (L _ (HsAppPrefix ty)) acc = extract_lty t_or_k ty
acc
> +extract_app t_or_k (L _ (HsAppInfix tv)) acc = extract_tv t_or_k
tv acc
> +extract_app t_or_k (L _ (HsAppPrefix ty)) acc = extract_lty t_or_k
ty acc
> +extract_app t_or_k (L _ (HsAppWild (L l wc))) acc = extract_lty t_or_k
(L l (HsWildCardTy wc)) acc
>
> extract_hs_tv_bndrs :: [LHsTyVarBndr RdrName] -> FreeKiTyVars
> -> FreeKiTyVars -> RnM FreeKiTyVars
> }}}
>
> Once I figure out how to do the `FIXME` part this patch may just work.
--
--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/13088#comment:1>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
More information about the ghc-tickets
mailing list