]> Git — Sourcephile - haskell/symantic-cli.git/blob - Symantic/CLI/Fixity.hs
8cd67ee8ed6351328ed5da3aac33bd78dd325404
[haskell/symantic-cli.git] / Symantic / CLI / Fixity.hs
1 module Symantic.CLI.Fixity where
2
3 import Data.Bool
4 import Data.Eq (Eq(..))
5 import Data.Function ((.))
6 import Data.Int (Int)
7 import Data.Maybe (Maybe(..))
8 import Data.Ord (Ord(..))
9 import Text.Show (Show(..))
10 import qualified Data.Bool as Bool
11
12 -- * Type 'Fixity'
13 data Fixity
14 = Fixity1 Unifix
15 | Fixity2 Infix
16 deriving (Eq, Show)
17
18 -- ** Type 'Unifix'
19 data Unifix
20 = Prefix { unifix_prece :: Precedence }
21 | Postfix { unifix_prece :: Precedence }
22 deriving (Eq, Show)
23
24 -- ** Type 'Infix'
25 data Infix
26 = Infix
27 { infix_assoc :: Maybe Associativity
28 , infix_prece :: Precedence
29 } deriving (Eq, Show)
30
31 infixL :: Precedence -> Infix
32 infixL = Infix (Just AssocL)
33
34 infixR :: Precedence -> Infix
35 infixR = Infix (Just AssocR)
36
37 infixB :: Side -> Precedence -> Infix
38 infixB = Infix . Just . AssocB
39
40 infixN :: Precedence -> Infix
41 infixN = Infix Nothing
42
43 infixN0 :: Infix
44 infixN0 = infixN 0
45
46 infixN5 :: Infix
47 infixN5 = infixN 5
48
49 -- | Given 'Precedence' and 'Associativity' of its parent operator,
50 -- and the operand 'Side' it is in,
51 -- return whether an 'Infix' operator
52 -- needs to be enclosed by parenthesis.
53 needsParenInfix :: (Infix, Side) -> Infix -> Bool
54 needsParenInfix (po, lr) op =
55 infix_prece op < infix_prece po
56 || infix_prece op == infix_prece po
57 && Bool.not associate
58 where
59 associate =
60 case (lr, infix_assoc po) of
61 (_, Just AssocB{}) -> True
62 (SideL, Just AssocL) -> True
63 (SideR, Just AssocR) -> True
64 _ -> False
65
66 -- * Type 'Precedence'
67 type Precedence = Int
68
69 -- ** Class 'PrecedenceOf'
70 class PrecedenceOf a where
71 precedence :: a -> Precedence
72 instance PrecedenceOf Fixity where
73 precedence (Fixity1 uni) = precedence uni
74 precedence (Fixity2 inf) = precedence inf
75 instance PrecedenceOf Unifix where
76 precedence = unifix_prece
77 instance PrecedenceOf Infix where
78 precedence = infix_prece
79
80 -- * Type 'Associativity'
81 data Associativity
82 = AssocL -- ^ Associate to the left: @a ¹ b ² c == (a ¹ b) ² c@
83 | AssocR -- ^ Associate to the right: @a ¹ b ² c == a ¹ (b ² c)@
84 | AssocB Side -- ^ Associate to both sides, but to 'Side' when reading.
85 deriving (Eq, Show)
86
87 -- ** Type 'Side'
88 data Side
89 = SideL -- ^ Left
90 | SideR -- ^ Right
91 deriving (Eq, Show)