never executed always true always false

    1 {-# LANGUAGE DeriveDataTypeable #-}
    2 
    3 -- | Fixity
    4 module GHC.Types.Fixity
    5    ( Fixity (..)
    6    , FixityDirection (..)
    7    , LexicalFixity (..)
    8    , maxPrecedence
    9    , minPrecedence
   10    , defaultFixity
   11    , negateFixity
   12    , funTyFixity
   13    , compareFixity
   14    )
   15 where
   16 
   17 import GHC.Prelude
   18 
   19 import GHC.Types.SourceText
   20 
   21 import GHC.Utils.Outputable
   22 import GHC.Utils.Binary
   23 
   24 import Data.Data hiding (Fixity, Prefix, Infix)
   25 
   26 data Fixity = Fixity SourceText Int FixityDirection
   27   -- Note [Pragma source text]
   28   deriving Data
   29 
   30 instance Outputable Fixity where
   31     ppr (Fixity _ prec dir) = hcat [ppr dir, space, int prec]
   32 
   33 instance Eq Fixity where -- Used to determine if two fixities conflict
   34   (Fixity _ p1 dir1) == (Fixity _ p2 dir2) = p1==p2 && dir1 == dir2
   35 
   36 instance Binary Fixity where
   37     put_ bh (Fixity src aa ab) = do
   38             put_ bh src
   39             put_ bh aa
   40             put_ bh ab
   41     get bh = do
   42           src <- get bh
   43           aa <- get bh
   44           ab <- get bh
   45           return (Fixity src aa ab)
   46 
   47 ------------------------
   48 data FixityDirection
   49    = InfixL
   50    | InfixR
   51    | InfixN
   52    deriving (Eq, Data)
   53 
   54 instance Outputable FixityDirection where
   55     ppr InfixL = text "infixl"
   56     ppr InfixR = text "infixr"
   57     ppr InfixN = text "infix"
   58 
   59 instance Binary FixityDirection where
   60     put_ bh InfixL =
   61             putByte bh 0
   62     put_ bh InfixR =
   63             putByte bh 1
   64     put_ bh InfixN =
   65             putByte bh 2
   66     get bh = do
   67             h <- getByte bh
   68             case h of
   69               0 -> return InfixL
   70               1 -> return InfixR
   71               _ -> return InfixN
   72 
   73 ------------------------
   74 maxPrecedence, minPrecedence :: Int
   75 maxPrecedence = 9
   76 minPrecedence = 0
   77 
   78 defaultFixity :: Fixity
   79 defaultFixity = Fixity NoSourceText maxPrecedence InfixL
   80 
   81 negateFixity, funTyFixity :: Fixity
   82 -- Wired-in fixities
   83 negateFixity = Fixity NoSourceText 6 InfixL  -- Fixity of unary negate
   84 funTyFixity  = Fixity NoSourceText (-1) InfixR  -- Fixity of '->', see #15235
   85 
   86 {-
   87 Consider
   88 
   89 \begin{verbatim}
   90         a `op1` b `op2` c
   91 \end{verbatim}
   92 @(compareFixity op1 op2)@ tells which way to arrange application, or
   93 whether there's an error.
   94 -}
   95 
   96 compareFixity :: Fixity -> Fixity
   97               -> (Bool,         -- Error please
   98                   Bool)         -- Associate to the right: a op1 (b op2 c)
   99 compareFixity (Fixity _ prec1 dir1) (Fixity _ prec2 dir2)
  100   = case prec1 `compare` prec2 of
  101         GT -> left
  102         LT -> right
  103         EQ -> case (dir1, dir2) of
  104                         (InfixR, InfixR) -> right
  105                         (InfixL, InfixL) -> left
  106                         _                -> error_please
  107   where
  108     right        = (False, True)
  109     left         = (False, False)
  110     error_please = (True,  False)
  111 
  112 -- |Captures the fixity of declarations as they are parsed. This is not
  113 -- necessarily the same as the fixity declaration, as the normal fixity may be
  114 -- overridden using parens or backticks.
  115 data LexicalFixity = Prefix | Infix deriving (Data,Eq)
  116 
  117 instance Outputable LexicalFixity where
  118   ppr Prefix = text "Prefix"
  119   ppr Infix  = text "Infix"