module Language.Symantic.Grammar.Fixity where
import Data.Bool as Bool
import Data.Eq (Eq(..))
import Data.Function ((.))
import Data.Int (Int)
import Data.Maybe (Maybe(..))
import Data.Ord (Ord(..))
import Data.Semigroup
import Data.String (IsString(..))
import Text.Show (Show)
data Fixity
= Fixity1 Unifix
| Fixity2 Infix
deriving (Eq, Show)
data Unifix
= Prefix { unifix_prece :: Precedence }
| Postfix { unifix_prece :: Precedence }
deriving (Eq, Show)
data Infix
= Infix
{ infix_assoc :: Maybe Associativity
, infix_prece :: Precedence
} deriving (Eq, Show)
infixL :: Precedence -> Infix
infixL = Infix (Just AssocL)
infixR :: Precedence -> Infix
infixR = Infix (Just AssocR)
infixB :: Side -> Precedence -> Infix
infixB = Infix . Just . AssocB
infixN :: Precedence -> Infix
infixN = Infix Nothing
infixN0 :: Infix
infixN0 = infixN 0
infixN5 :: Infix
infixN5 = infixN 5
needsParenInfix :: (Infix, Side) -> Infix -> Bool
needsParenInfix (po, lr) op =
infix_prece op < infix_prece po
|| infix_prece op == infix_prece po
&& Bool.not associate
where
associate =
case (lr, infix_assoc po) of
(_, Just AssocB{}) -> True
(SideL, Just AssocL) -> True
(SideR, Just AssocR) -> True
_ -> False
parenInfix
:: (Semigroup s, IsString s)
=> (Infix, Side) -> Infix -> s -> s
parenInfix po op s =
if needsParenInfix po op
then fromString "(" <> s <> fromString ")"
else s
type Precedence = Int
class PrecedenceOf a where
precedence :: a -> Precedence
instance PrecedenceOf Fixity where
precedence (Fixity1 uni) = precedence uni
precedence (Fixity2 inf) = precedence inf
instance PrecedenceOf Unifix where
precedence = unifix_prece
instance PrecedenceOf Infix where
precedence = infix_prece
data Associativity
= AssocL
| AssocR
| AssocB Side
deriving (Eq, Show)
data Side
= SideL
| SideR
deriving (Eq, Show)