module Language.Symantic.Grammar.Fixity where
import Data.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 (String, IsString(..))
import Text.Show (Show(..))
data Fixity
= Fixity1 Unifix
| Fixity2 Infix
deriving (Eq, Show)
data Unifix
= Prefix { unifix_precedence :: Precedence }
| Postfix { unifix_precedence :: Precedence }
deriving (Eq, Show)
data Infix
= Infix
{ infix_associativity :: Maybe Associativity
, infix_precedence :: 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
isPairNeeded :: (Infix, Side) -> Infix -> Bool
isPairNeeded (po, lr) op =
infix_precedence op < infix_precedence po
|| infix_precedence op == infix_precedence po
&& not associate
where
associate =
case (lr, infix_associativity po) of
(_, Just AssocB{}) -> True
(SideL, Just AssocL) -> True
(SideR, Just AssocR) -> True
_ -> False
pairIfNeeded ::
Semigroup s => IsString s =>
Pair -> (Infix, Side) -> Infix ->
s -> s
pairIfNeeded (o,c) po op s =
if isPairNeeded po op
then fromString o <> s <> fromString c
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_precedence
instance PrecedenceOf Infix where
precedence = infix_precedence
data Associativity
= AssocL
| AssocR
| AssocB Side
deriving (Eq, Show)
data Side
= SideL
| SideR
deriving (Eq, Show)
type Pair = (String, String)
pairParen, pairBrace :: Pair
pairParen = ("(",")")
pairBrace = ("{","}")