Commit 251e3424 authored by Alec Theriault's avatar Alec Theriault Committed by Ryan Scott
Browse files

Set `infixr -1 ->`

Summary:
This simply makes explicit what is already the case. Due to special
treatment in the parser, `->` has the lowest fixity. This patch propagates
that information to:

  * GHCi, where `:info ->` now return the right fixity
  * TH, where `reifyFixity` returns the right fixity
  * the generated sources for `GHC.Prim`

See #15235.

Test Plan: make test

Reviewers: bgamari, alanz, RyanGlScott

Reviewed By: RyanGlScott

Subscribers: int-index, RyanGlScott, rwbarton, mpickering, carter

GHC Trac Issues: #15235

Differential Revision: https://phabricator.haskell.org/D5199
parent ba163c3b
......@@ -410,7 +410,7 @@ defaultFixity = Fixity NoSourceText maxPrecedence InfixL
negateFixity, funTyFixity :: Fixity
-- Wired-in fixities
negateFixity = Fixity NoSourceText 6 InfixL -- Fixity of unary negate
funTyFixity = Fixity NoSourceText 0 InfixR -- Fixity of '->'
funTyFixity = Fixity NoSourceText (-1) InfixR -- Fixity of '->', see #15235
{-
Consider
......
......@@ -998,7 +998,7 @@ impspec :: { Located (Bool, Located [LIE GhcPs]) }
prec :: { Located (SourceText,Int) }
: {- empty -} { noLoc (NoSourceText,9) }
| INTEGER
{% checkPrecP (sL1 $1 (getINTEGERs $1,fromInteger (il_value (getINTEGER $1)))) }
{ sL1 $1 (getINTEGERs $1,fromInteger (il_value (getINTEGER $1))) }
infix :: { Located FixityDirection }
: 'infix' { sL1 $1 InfixN }
......@@ -2378,7 +2378,8 @@ sigdecl :: { LHsDecl GhcPs }
[mu AnnDcolon $4] } }
| infix prec ops
{% ams (sLL $1 $> $ SigD noExt
{% checkPrecP $2 $3 >>
ams (sLL $1 $> $ SigD noExt
(FixSig noExt (FixitySig noExt (fromOL $ unLoc $3)
(Fixity (fst $ unLoc $2) (snd $ unLoc $2) (unLoc $1)))))
[mj AnnInfix $1,mj AnnVal $2] }
......@@ -3243,6 +3244,7 @@ op :: { Located RdrName } -- used in infix decls
: varop { $1 }
| conop { $1 }
| '->' { sL1 $1 $ getRdrName funTyCon }
| '~' { sL1 $1 $ eqTyCon_RDR }
varop :: { Located RdrName }
: varsym { $1 }
......
......@@ -87,7 +87,7 @@ import BasicTypes
import TcEvidence ( idHsWrapper )
import Lexer
import Lexeme ( isLexCon )
import Type ( TyThing(..) )
import Type ( TyThing(..), funTyCon )
import TysWiredIn ( cTupleTyConName, tupleTyCon, tupleDataCon,
nilDataConName, nilDataConKey,
listTyConName, listTyConKey, eqTyCon_RDR,
......@@ -1756,11 +1756,19 @@ cmdStmtFail loc e = parseErrorSDoc loc
---------------------------------------------------------------------------
-- Miscellaneous utilities
checkPrecP :: Located (SourceText,Int) -> P (Located (SourceText,Int))
checkPrecP (L l (src,i))
| 0 <= i && i <= maxPrecedence = return (L l (src,i))
| otherwise
= parseErrorSDoc l (text ("Precedence out of range: " ++ show i))
-- | Check if a fixity is valid. We support bypassing the usual bound checks
-- for some special operators.
checkPrecP
:: Located (SourceText,Int) -- ^ precedence
-> Located (OrdList (Located RdrName)) -- ^ operators
-> P ()
checkPrecP (L l (_,i)) (L _ ol)
| 0 <= i, i <= maxPrecedence = pure ()
| all specialOp ol = pure ()
| otherwise = parseErrorSDoc l (text ("Precedence out of range: " ++ show i))
where
specialOp op = unLoc op `elem` [ eqTyCon_RDR
, getRdrName funTyCon ]
mkRecConstrOrUpdate
:: LHsExpr GhcPs
......
......@@ -169,7 +169,7 @@ primtype (->) a b
Note that {\tt a -> b} permits levity-polymorphism in both {\tt a} and
{\tt b}, so that types like {\tt Int\# -> Int\#} can still be well-kinded.
}
with fixity = infixr 0
with fixity = infixr -1
-- This fixity is only the one picked up by Haddock. If you
-- change this, do update 'ghcPrimIface' in 'LoadIface.hs'.
......
......@@ -2409,8 +2409,7 @@ specifically:
sets the fixity for both type constructor ``T`` and data constructor
``T``, and similarly for ``:*:``. ``Int `a` Bool``.
 
- Function arrow is ``infixr`` with fixity 0 (this might change; it's
not clear what it should be).
- The function arrow ``->`` is ``infixr`` with fixity -1.
 
.. _type-operators:
 
......
data (->) (a :: TYPE q) (b :: TYPE r) -- Defined in ‘GHC.Prim’
infixr 0 ->
infixr -1 ->
instance Applicative ((->) a) -- Defined in ‘GHC.Base’
instance Functor ((->) r) -- Defined in ‘GHC.Base’
instance Monad ((->) r) -- Defined in ‘GHC.Base’
......
data (->) (a :: TYPE q) (b :: TYPE r) -- Defined in ‘GHC.Prim’
infixr 0 ->
infixr -1 ->
instance Applicative ((->) a) -- Defined in ‘GHC.Base’
instance Functor ((->) r) -- Defined in ‘GHC.Base’
instance Monad ((->) r) -- Defined in ‘GHC.Base’
......
data (->) (a :: TYPE q) (b :: TYPE r) -- Defined in ‘GHC.Prim’
infixr 0 ->
infixr -1 ->
instance Applicative ((->) a) -- Defined in ‘GHC.Base’
instance Functor ((->) r) -- Defined in ‘GHC.Base’
instance Monad ((->) r) -- Defined in ‘GHC.Base’
......
Just (Fixity 0 InfixR)
Just (Fixity (-1) InfixR)
Nothing
Nothing
Just (Fixity 6 InfixL)
......
......@@ -244,6 +244,7 @@ gen_hs_source (Info defaults entries) =
++ "{-# LANGUAGE MultiParamTypeClasses #-}\n"
++ "{-# LANGUAGE NoImplicitPrelude #-}\n"
++ "{-# LANGUAGE UnboxedTuples #-}\n"
++ "{-# LANGUAGE NegativeLiterals #-}\n"
++ "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n"
-- We generate a binding for coerce, like
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment