1 files changed, 119 insertions, 0 deletions
diff --git a/compiler/GHC/Types/Fixity.hs b/compiler/GHC/Types/Fixity.hs
new file mode 100644
index 0000000000..fb8807ab9d
--- /dev/null
+++ b/compiler/GHC/Types/Fixity.hs
@@ -0,0 +1,119 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+-- | Fixity
+module GHC.Types.Fixity
+   ( Fixity (..)
+   , FixityDirection (..)
+   , LexicalFixity (..)
+   , maxPrecedence
+   , minPrecedence
+   , defaultFixity
+   , negateFixity
+   , funTyFixity
+   , compareFixity
+   )
+where
+
+import GHC.Prelude
+
+import GHC.Types.SourceText
+
+import GHC.Utils.Outputable
+import GHC.Utils.Binary
+
+import Data.Data hiding (Fixity, Prefix, Infix)
+
+data Fixity = Fixity SourceText Int FixityDirection
+  -- Note [Pragma source text]
+  deriving Data
+
+instance Outputable Fixity where
+    ppr (Fixity _ prec dir) = hcat [ppr dir, space, int prec]
+
+instance Eq Fixity where -- Used to determine if two fixities conflict
+  (Fixity _ p1 dir1) == (Fixity _ p2 dir2) = p1==p2 && dir1 == dir2
+
+instance Binary Fixity where
+    put_ bh (Fixity src aa ab) = do
+            put_ bh src
+            put_ bh aa
+            put_ bh ab
+    get bh = do
+          src <- get bh
+          aa <- get bh
+          ab <- get bh
+          return (Fixity src aa ab)
+
+------------------------
+data FixityDirection
+   = InfixL
+   | InfixR
+   | InfixN
+   deriving (Eq, Data)
+
+instance Outputable FixityDirection where
+    ppr InfixL = text "infixl"
+    ppr InfixR = text "infixr"
+    ppr InfixN = text "infix"
+
+instance Binary FixityDirection where
+    put_ bh InfixL = do
+            putByte bh 0
+    put_ bh InfixR = do
+            putByte bh 1
+    put_ bh InfixN = do
+            putByte bh 2
+    get bh = do
+            h <- getByte bh
+            case h of
+              0 -> do return InfixL
+              1 -> do return InfixR
+              _ -> do return InfixN
+
+------------------------
+maxPrecedence, minPrecedence :: Int
+maxPrecedence = 9
+minPrecedence = 0
+
+defaultFixity :: Fixity
+defaultFixity = Fixity NoSourceText maxPrecedence InfixL
+
+negateFixity, funTyFixity :: Fixity
+-- Wired-in fixities
+negateFixity = Fixity NoSourceText 6 InfixL  -- Fixity of unary negate
+funTyFixity  = Fixity NoSourceText (-1) InfixR  -- Fixity of '->', see #15235
+
+{-
+Consider
+
+\begin{verbatim}
+        a `op1` b `op2` c
+\end{verbatim}
+@(compareFixity op1 op2)@ tells which way to arrange application, or
+whether there's an error.
+-}
+
+compareFixity :: Fixity -> Fixity
+              -> (Bool,         -- Error please
+                  Bool)         -- Associate to the right: a op1 (b op2 c)
+compareFixity (Fixity _ prec1 dir1) (Fixity _ prec2 dir2)
+  = case prec1 `compare` prec2 of
+        GT -> left
+        LT -> right
+        EQ -> case (dir1, dir2) of
+                        (InfixR, InfixR) -> right
+                        (InfixL, InfixL) -> left
+                        _                -> error_please
+  where
+    right        = (False, True)
+    left         = (False, False)
+    error_please = (True,  False)
+
+-- |Captures the fixity of declarations as they are parsed. This is not
+-- necessarily the same as the fixity declaration, as the normal fixity may be
+-- overridden using parens or backticks.
+data LexicalFixity = Prefix | Infix deriving (Data,Eq)
+
+instance Outputable LexicalFixity where
+  ppr Prefix = text "Prefix"
+  ppr Infix  = text "Infix"