Fixity Resolution

https://www.haskell.org/onlinereport/haskell2010/haskellch10.html#x17-18100010.6

Haskellのリファレンスに掲載されている 結合性の解決方法を示したコードを動作確認のために動かした時のメモ。

以下は上記のページに掲載されているコード。

import Control.Monad
 
type Prec   = Int  
type Var    = String  
 
data Op = Op String Prec Fixity  
  deriving (Eq,Show)  
 
data Fixity = Leftfix | Rightfix | Nonfix  
  deriving (Eq,Show)  
 
data Exp = Var Var | OpApp Exp Op Exp | Neg Exp  
  deriving (Eq,Show)  
 
data Tok = TExp Exp | TOp Op | TNeg  
  deriving (Eq,Show)  
 
resolve :: [Tok] -> Maybe Exp  
resolve tokens = fmap fst $ parseNeg (Op "" (-1) Nonfix) tokens  
  where  
    parseNeg :: Op -> [Tok] -> Maybe (Exp,[Tok])  
    parseNeg op1 (TExp e1 : rest)  
       = parse op1 e1 rest  
    parseNeg op1 (TNeg : rest)  
       = do guard (prec1 < 6)  
            (r, rest') <- parseNeg (Op "-" 6 Leftfix) rest  
            parse op1 (Neg r) rest'  
       where  
          Op _ prec1 fix1 = op1  
 
    parse :: Op -> Exp -> [Tok] -> Maybe (Exp, [Tok])  
    parse _   e1 [] = Just (e1, [])  
    parse op1 e1 (TOp op2 : rest)  
       -- case (1): check for illegal expressions  
       | prec1 == prec2 && (fix1 /= fix2 || fix1 == Nonfix)  
       = Nothing  
 
       -- case (2): op1 and op2 should associate to the left  
       | prec1 > prec2 || (prec1 == prec2 && fix1 == Leftfix)  
       = Just (e1, TOp op2 : rest)  
 
       -- case (3): op1 and op2 should associate to the right  
       | otherwise  
       = do (r,rest') <- parseNeg op2 rest  
            parse op1 (OpApp e1 op2 r) rest'  
       where  
         Op _ prec1 fix1 = op1  
         Op _ prec2 fix2 = op2 

以下はテスト用のトークンを適当に定義したコード。

plus = Op "+" 6 Leftfix
minus = Op "-" 6 Leftfix
ast = Op "*" 7 Leftfix
slash = Op "/" 7 Leftfix

app = Op "->" 1 Rightfix
rplus = Op "+." 6 Rightfix

a = Var "a"
b = Var "b"
c = Var "c"
d = Var "d"

-- a + b +. c
-- -> illegal expressions
tokens1 = [TExp a, TOp plus, TExp b, TOp rplus, TExp c]

-- a + b - c
-- -> (a + b) - c
tokens2 = [TExp a, TOp plus, TExp b, TOp minus, TExp c]

-- a -> b -> c
-- -> a -> (b -> c)
tokens3 = [TExp a, TOp app, TExp b, TOp app, TExp c]

-- -a + b
-- -> (-a) + b
tokens4 = [TNeg, TExp a, TOp plus, TExp b]

-- a + -b
-- -> illegal expressions
tokens5 = [TExp a, TOp plus, TNeg, TExp b]

-- a + b * c - d
-- -> (a + (b * c)) - d
tokens6 = [TExp a, TOp plus, TExp b, TOp ast, TExp c, TOp minus, TExp d]

-- a + b -> c
-- -> (a + b) -> c
tokens7 = [TExp a, TOp plus, TExp b, TOp app, TExp c]

-- a -> b + c
-- -> a -> (b + c)
tokens8 = [TExp a, TOp app, TExp b, TOp plus, TExp c]

このコードをghciで読み込み、以下のように入力すれば結果が返ってくる。

resolve tokens1
resolve tokens2
...