Can't use type wildcard infix

This fails:

foo :: Int `_a` Bool
foo = Right True

But moving _a to be prefix works. I observe the same behavior with an unnamed type wildcard.

This was discovered while poking around in the renamer, not in real code!

Trac metadata

Trac field	Value
Version	7.11
Type	Bug
TypeOfFailure	OtherFailure
Priority	normal
Resolution	Unresolved
Component	Compiler
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system
Architecture

changed weight to 5

added Tbug Trac import labels

mentioned in issue #13088 (closed)

Copying over the comments from #13088 (closed), a duplicate of this:

Originally noted in https://phabricator.haskell.org/D2910 (which fixed #13050 (closed)). Currently, you can do this:

{-# LANGUAGE TypeOperators #-}
foo :: a `_over` b -> _over a b
foo = id

But not this:

{-# LANGUAGE TypeOperators #-}
foo :: a `_` b -> over a b
foo = id

osa1 made an attempt at fixing this, and recorded his progress 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 --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.

Trac metadata

Trac field	Value
Related	- → #13088 (closed)

added Pnormal label

added newcomer label