[commit: ghc] master: Set `infixr -1 ->` (251e342)
git at git.haskell.org
git at git.haskell.org
Thu Oct 4 23:38:44 UTC 2018
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/251e3424a96986fca5164a2397783a1c066558fc/ghc
>---------------------------------------------------------------
commit 251e3424a96986fca5164a2397783a1c066558fc
Author: Alec Theriault <alec.theriault at gmail.com>
Date: Thu Oct 4 18:13:28 2018 -0400
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
>---------------------------------------------------------------
251e3424a96986fca5164a2397783a1c066558fc
compiler/basicTypes/BasicTypes.hs | 2 +-
compiler/parser/Parser.y | 6 ++++--
compiler/parser/RdrHsSyn.hs | 20 ++++++++++++++------
compiler/prelude/primops.txt.pp | 2 +-
docs/users_guide/glasgow_exts.rst | 3 +--
testsuite/tests/ghci/scripts/T8535.stdout | 2 +-
testsuite/tests/ghci/scripts/ghci020.stdout | 2 +-
testsuite/tests/ghci/should_run/T10145.stdout | 2 +-
testsuite/tests/th/T10704.stdout | 2 +-
utils/genprimopcode/Main.hs | 1 +
10 files changed, 26 insertions(+), 16 deletions(-)
diff --git a/compiler/basicTypes/BasicTypes.hs b/compiler/basicTypes/BasicTypes.hs
index 151a040..cf56957 100644
--- a/compiler/basicTypes/BasicTypes.hs
+++ b/compiler/basicTypes/BasicTypes.hs
@@ -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
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 25eb008..74db997 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -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 }
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index 91fcb0d..1015319 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -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
diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp
index 2d2fff4..7360ccb 100644
--- a/compiler/prelude/primops.txt.pp
+++ b/compiler/prelude/primops.txt.pp
@@ -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'.
diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst
index 1664dbc..4a77f3b 100644
--- a/docs/users_guide/glasgow_exts.rst
+++ b/docs/users_guide/glasgow_exts.rst
@@ -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:
diff --git a/testsuite/tests/ghci/scripts/T8535.stdout b/testsuite/tests/ghci/scripts/T8535.stdout
index 6ae0c4c..a0a5730 100644
--- a/testsuite/tests/ghci/scripts/T8535.stdout
+++ b/testsuite/tests/ghci/scripts/T8535.stdout
@@ -1,5 +1,5 @@
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’
diff --git a/testsuite/tests/ghci/scripts/ghci020.stdout b/testsuite/tests/ghci/scripts/ghci020.stdout
index 6ae0c4c..a0a5730 100644
--- a/testsuite/tests/ghci/scripts/ghci020.stdout
+++ b/testsuite/tests/ghci/scripts/ghci020.stdout
@@ -1,5 +1,5 @@
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’
diff --git a/testsuite/tests/ghci/should_run/T10145.stdout b/testsuite/tests/ghci/should_run/T10145.stdout
index 6ae0c4c..a0a5730 100644
--- a/testsuite/tests/ghci/should_run/T10145.stdout
+++ b/testsuite/tests/ghci/should_run/T10145.stdout
@@ -1,5 +1,5 @@
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’
diff --git a/testsuite/tests/th/T10704.stdout b/testsuite/tests/th/T10704.stdout
index 99b87e2..5d6d015 100644
--- a/testsuite/tests/th/T10704.stdout
+++ b/testsuite/tests/th/T10704.stdout
@@ -1,4 +1,4 @@
-Just (Fixity 0 InfixR)
+Just (Fixity (-1) InfixR)
Nothing
Nothing
Just (Fixity 6 InfixL)
diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs
index a0e9d54..e4779bf 100644
--- a/utils/genprimopcode/Main.hs
+++ b/utils/genprimopcode/Main.hs
@@ -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
More information about the ghc-commits
mailing list