Add fixity information to primops (ticket #6026)

4 files changed, 44 insertions, 4 deletions

diff --git a/compiler/ghc.mk b/compiler/ghc.mk
index f3b4fead5d..887f91b280 100644
--- a/compiler/ghc.mk
+++ b/compiler/ghc.mk
@@ -240,6 +240,7 @@ PRIMOP_BITS_NAMES = primop-data-decl.hs-incl        \
                     primop-code-size.hs-incl        \
                     primop-can-fail.hs-incl         \
                     primop-strictness.hs-incl       \
+                    primop-fixity.hs-incl       \
                     primop-primop-info.hs-incl
 
 PRIMOP_BITS_STAGE1 = $(addprefix compiler/stage1/build/,$(PRIMOP_BITS_NAMES))
@@ -276,6 +277,8 @@ compiler/stage$1/build/primop-can-fail.hs-incl: compiler/stage$1/build/primops.t
 	"$$(GENPRIMOP_INPLACE)" --can-fail           < $$< > $$@
 compiler/stage$1/build/primop-strictness.hs-incl: compiler/stage$1/build/primops.txt $$(GENPRIMOP_INPLACE)
 	"$$(GENPRIMOP_INPLACE)" --strictness         < $$< > $$@
+compiler/stage$1/build/primop-fixity.hs-incl: compiler/stage$1/build/primops.txt $$(GENPRIMOP_INPLACE)
+	"$$(GENPRIMOP_INPLACE)" --fixity             < $$< > $$@
 compiler/stage$1/build/primop-primop-info.hs-incl: compiler/stage$1/build/primops.txt $$(GENPRIMOP_INPLACE)
 	"$$(GENPRIMOP_INPLACE)" --primop-primop-info < $$< > $$@
 
diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs
index f978577b23..6dfac27d5d 100644
--- a/compiler/iface/LoadIface.lhs
+++ b/compiler/iface/LoadIface.lhs
@@ -38,6 +38,7 @@ import TcRnMonad
 import Constants
 import PrelNames
 import PrelInfo
+import PrimOp   ( allThePrimOps, primOpFixity, primOpOcc )
 import MkId     ( seqId )
 import Rules
 import Annotations
@@ -604,8 +605,9 @@ ghcPrimIface
         mi_fix_fn  = mkIfaceFixCache fixities
     }           
   where
-    fixities = [(getOccName seqId, Fixity 0 InfixR)]
-                        -- seq is infixr 0
+    fixities = (getOccName seqId, Fixity 0 InfixR)  -- seq is infixr 0
+             : mapMaybe mkFixity allThePrimOps
+    mkFixity op = (,) (primOpOcc op) <$> primOpFixity op
 \end{code}
 
 %*********************************************************
diff --git a/compiler/prelude/PrimOp.lhs b/compiler/prelude/PrimOp.lhs
index b055376060..1aaca36274 100644
--- a/compiler/prelude/PrimOp.lhs
+++ b/compiler/prelude/PrimOp.lhs
@@ -13,7 +13,7 @@ module PrimOp (
 
         primOpOutOfLine, primOpCodeSize,
         primOpOkForSpeculation, primOpOkForSideEffects,
-        primOpIsCheap,
+        primOpIsCheap, primOpFixity,
 
         getPrimOpResultInfo,  PrimOpResultInfo(..),
 
@@ -31,7 +31,7 @@ import OccName          ( OccName, pprOccName, mkVarOccFS )
 import TyCon            ( TyCon, isPrimTyCon, tyConPrimRep, PrimRep(..) )
 import Type             ( Type, mkForAllTys, mkFunTy, mkFunTys, tyConAppTyCon,
                           typePrimRep )
-import BasicTypes       ( Arity, TupleSort(..) )
+import BasicTypes       ( Arity, Fixity(..), FixityDirection(..), TupleSort(..) )
 import ForeignCall      ( CLabelString )
 import Unique           ( Unique, mkPrimOpIdUnique )
 import Outputable
@@ -153,6 +153,17 @@ primOpStrictness :: PrimOp -> Arity -> StrictSig
 
 %************************************************************************
 %*                                                                      *
+\subsubsection{Fixity}
+%*                                                                      *
+%************************************************************************
+
+\begin{code}
+primOpFixity :: PrimOp -> Maybe Fixity
+#include "primop-fixity.hs-incl"
+\end{code}
+
+%************************************************************************
+%*                                                                      *
 \subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}
 %*                                                                      *
 %************************************************************************
diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp
index 92d33547d1..c6e1b47706 100644
--- a/compiler/prelude/primops.txt.pp
+++ b/compiler/prelude/primops.txt.pp
@@ -46,6 +46,7 @@ defaults
    commutable       = False
    code_size        = { primOpCodeSizeDefault }
    strictness       = { \ arity -> mkStrictSig (mkTopDmdType (replicate arity lazyDmd) TopRes) }
+   fixity           = Nothing
 
 
 -- Currently, documentation is produced using latex, so contents of
@@ -166,13 +167,16 @@ primtype Int#
 primop   IntAddOp    "+#"    Dyadic
    Int# -> Int# -> Int#
    with commutable = True
+        fixity = infixl 6
 
 primop   IntSubOp    "-#"    Dyadic   Int# -> Int# -> Int#
+   with fixity = infixl 6
 
 primop   IntMulOp    "*#" 
    Dyadic   Int# -> Int# -> Int#
    {Low word of signed integer multiply.}
    with commutable = True
+        fixity = infixl 7
 
 primop   IntMulMayOfloOp  "mulIntMayOflo#" 
    Dyadic   Int# -> Int# -> Int#
@@ -225,18 +229,26 @@ primop   IntSubCOp   "subIntC#"    GenPrimOp   Int# -> Int# -> (# Int#, Int# #)
    with code_size = 2
 
 primop   IntGtOp  ">#"   Compare   Int# -> Int# -> Bool
+   with fixity = infix 4
+
 primop   IntGeOp  ">=#"   Compare   Int# -> Int# -> Bool
+   with fixity = infix 4
 
 primop   IntEqOp  "==#"   Compare
    Int# -> Int# -> Bool
    with commutable = True
+        fixity = infix 4
 
 primop   IntNeOp  "/=#"   Compare
    Int# -> Int# -> Bool
    with commutable = True
+        fixity = infix 4
 
 primop   IntLtOp  "<#"   Compare   Int# -> Int# -> Bool
+   with fixity = infix 4
+
 primop   IntLeOp  "<=#"   Compare   Int# -> Int# -> Bool
+   with fixity = infix 4
 
 primop   ChrOp   "chr#"   GenPrimOp   Int# -> Char#
    with code_size = 0
@@ -401,32 +413,44 @@ section "Double#"
 primtype Double#
 
 primop   DoubleGtOp ">##"   Compare   Double# -> Double# -> Bool
+   with fixity = infix 4
+
 primop   DoubleGeOp ">=##"   Compare   Double# -> Double# -> Bool
+   with fixity = infix 4
 
 primop DoubleEqOp "==##"   Compare
    Double# -> Double# -> Bool
    with commutable = True
+        fixity = infix 4
 
 primop DoubleNeOp "/=##"   Compare
    Double# -> Double# -> Bool
    with commutable = True
+        fixity = infix 4
 
 primop   DoubleLtOp "<##"   Compare   Double# -> Double# -> Bool
+   with fixity = infix 4
+
 primop   DoubleLeOp "<=##"   Compare   Double# -> Double# -> Bool
+   with fixity = infix 4
 
 primop   DoubleAddOp   "+##"   Dyadic
    Double# -> Double# -> Double#
    with commutable = True
+        fixity = infixl 6
 
 primop   DoubleSubOp   "-##"   Dyadic   Double# -> Double# -> Double#
+   with fixity = infixl 6
 
 primop   DoubleMulOp   "*##"   Dyadic
    Double# -> Double# -> Double#
    with commutable = True
+        fixity = infixl 7
 
 primop   DoubleDivOp   "/##"   Dyadic
    Double# -> Double# -> Double#
    with can_fail = True
+        fixity = infixl 7
 
 primop   DoubleNegOp   "negateDouble#"  Monadic   Double# -> Double#