1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
|
module Operators where
data Op =
Op Int Fixity
deriving (Show, Eq)
data ArgKind
= X
| Y
deriving (Show, Eq)
data Fixity
= Infix ArgKind ArgKind
| Prefix ArgKind
| Suffix ArgKind
deriving (Show, Eq)
isPrefix (Prefix _) = True
isPrefix _ = False
numArgs :: Op -> Int
numArgs (Op _ f) = go f
where
go (Infix _ _) = 2
go _ = 1
type Ops = [(String, Op)]
argKind :: Char -> Maybe ArgKind
argKind 'x' = Just X
argKind 'y' = Just Y
argKind _ = Nothing
fixity :: String -> Maybe Fixity
fixity [l, 'f', r] = Infix <$> argKind l <*> argKind r
fixity ['f', x] = Prefix <$> argKind x
fixity [x, 'f'] = Suffix <$> argKind x
fixity _ = Nothing
xfx, xfy, yfx, fx, fy, xf, yf :: String -> Int -> (String, Op)
xfx o p = (o, Op p (Infix X X))
xfy o p = (o, Op p (Infix X Y))
yfx o p = (o, Op p (Infix Y X))
fx o p = (o, Op p (Prefix X))
fy o p = (o, Op p (Prefix Y))
xf o p = (o, Op p (Suffix X))
yf o p = (o, Op p (Suffix Y))
|
