[GHC] #11107: Can't use type wildcard infix
GHC
ghc-devs at haskell.org
Mon Feb 26 02:28:46 UTC 2018
#11107: Can't use type wildcard infix
-------------------------------------+-------------------------------------
Reporter: goldfire | Owner: (none)
Type: bug | Status: new
Priority: normal | Milestone:
Component: Compiler | Version: 7.11
Resolution: | Keywords:
Operating System: Unknown/Multiple | Architecture:
| Unknown/Multiple
Type of failure: None/Unknown | Test Case:
Blocked By: | Blocking:
Related Tickets: #13088 | Differential Rev(s):
Wiki Page: |
-------------------------------------+-------------------------------------
Changes (by RyanGlScott):
* related: => #13088
Comment:
Copying over the comments from #13088, a duplicate of this:
> 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/11107#comment:1>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
More information about the ghc-tickets
mailing list