部分式に名前を付けるバージョン ref: http://qiita.com/items/341b5a2263719f3c8672

ifphex010203.hs

-- | 式の定義
data Expr = Zero
          | Pred Expr
          | Succ Expr
  deriving (Show)

-- | 位置情報付き式
data AExpr' = AZero
            | APred AExpr
            | ASucc AExpr 
  deriving (Show)

type AExpr = (Pos,AExpr')
type Pos   = Int

-- | 位置情報の付加
annotate :: Pos -> Expr -> AExpr
annotate p Zero     = (p,AZero)
annotate p (Pred t) = (p,APred (annotate (succ p) t))
annotate p (Succ t) = (p,ASucc (annotate (succ p) t))


-- | Redex(簡約可能式)を数える．
countRedexA :: AExpr -> Int
countRedexA (_,AZero)   = 0
countRedexA (_,APred t) = case snd t of
  ASucc _ -> 1 + countRedexA t
  _       -> countRedexA t
countRedexA (_,ASucc t) = case snd t of
  APred _ -> 1 + countRedexA t
  _       -> countRedexA t

-- | 1ステップの簡約(複数の結果がありうる)
reduceA :: AExpr -> [AExpr]
reduceA (_,AZero)     = []
reduceA (p,APred t) = case snd t of
  ASucc t' -> t' : map ((,) p . APred) (reduceA t)
  _        -> map ((,) p . APred) (reduceA t)
reduceA (p,ASucc t) = case snd t of
  APred t' -> t' : map ((,) p . ASucc) (reduceA t)
  _             -> map ((,) p . ASucc) (reduceA t)

-- | 簡約系列の生成
redSeqsA :: AExpr -> [[AExpr]]
redSeqsA t = case reduceA t of
  [] -> [[t]]
  ts -> concatMap (map (t:) . redSeqsA) ts

-- | 簡約系列の数
countRedSeqsA :: AExpr -> Int
countRedSeqsA =  length . redSeqsA

-- | IFPH 練習問題 1.2.3 で与えられた式
exer010203 :: Expr
exer010203 =  Succ(Pred(Succ(Pred(Pred(Zero)))))

{-
実行例:
? putStr $ unlines $ map show $ redSeqsA $ annotate 0 exer010203
[(0,ASucc (1,APred (2,ASucc (3,APred (4,APred (5,AZero)))))),(2,ASucc (3,APred (4,APred (5,AZero)))),(4,APred (5,AZero))]
[(0,ASucc (1,APred (2,ASucc (3,APred (4,APred (5,AZero)))))),(0,ASucc (3,APred (4,APred (5,AZero)))),(4,APred (5,AZero))]
[(0,ASucc (1,APred (2,ASucc (3,APred (4,APred (5,AZero)))))),(0,ASucc (1,APred (4,APred (5,AZero)))),(4,APred (5,AZero))]
-}