Haskell - モジュールプログラミング(シンボルテーブルプログラム)

すごいHaskellたのしく学ぼう!
(オーム社)
Miran Lipovača (著)
田中 英行 村主 崇行 (翻訳)
[Kindle版]

開発環境

• OS X Mavericks - Apple(OS)
• BBEdit - Bare Bones Software, Inc., Emacs (Text Editor)
• Haskell (純粋関数型プログラミング言語)
• GHC (The Glasgow Haskell Compiler) (処理系)
• The Haskell Platform (インストール方法、モジュール等)

C実践プログラミング 第3版 (Steve Oualline (著)、 望月 康司 (監訳) (翻訳)、谷口 功 (翻訳)、オライリー・ジャパン)のⅢ部(高度なプログラミング概念)の18章(モジュールプログラミング)、18-14(プログラミング実習)、実習18-3.をHaskellで解いてみる。

その他参考書籍

• プログラミングHaskell (オーム社) Graham Hutton(著) 山本 和彦(翻訳)
• Real World Haskell―実戦で学ぶ関数型言語プログラミング (オライリージャパン) Bryan O'Sullivan John Goerzen Don Stewart(著) 山下 伸夫 伊東 勝利 株式会社タイムインターメディア(翻訳)

18-14(プログラミング実習)、実習18-3.

コード(BBEdit)

Sample.hs

{-# OPTIONS -Wall -Werror #-}
import SymbolTable

main :: IO ()
main = do
    let new_ts = scanl (\acc x -> insert x acc) t symbols
        new_t = last new_ts
        bs = map (\x -> find x new_t) ["Int", "String", "Double", "Float"]
        new_ts' = scanl (\acc x -> delete x acc) new_t symbols
    mapM_ print new_ts
    mapM_ print bs
    mapM_ print new_ts'

t :: Tree a
t = mkTree

symbols :: [String]
symbols = ["Int", "Double", "Char", "String"]

コード(BBEdit)

SymbolTable.hs

{-# OPTIONS -Wall -Werror *-}
module SymbolTable (Tree,
                    mkTree,
                    insert,
                    delete,
                    find) where

data Tree a = Empty | Node a (Tree a) (Tree a) deriving (Show)

mkTree :: Tree a
mkTree = Empty

singleton :: a -> Tree a
singleton x = Node x Empty Empty

insert :: (Ord a) => a -> Tree a -> Tree a
insert x Empty = singleton x
insert x t@(Node a left right)
    | x < a = Node a (insert x left) right
    | x > a = Node a left (insert x right)
    | otherwise = t

delete :: (Ord a) => a -> Tree a -> Tree a
delete _ Empty = Empty
delete x (Node a left right)
    | x < a = Node a (delete x left) right
    | x > a = Node a left (delete x right)
    | otherwise = appendTree left right

find :: (Ord a) => a -> Tree a -> Bool
find x Empty = False
find x (Node a left right)
    | x == a = True
    | x > a = find x right
    | x < a = find x left

appendTree :: (Ord a) => Tree a -> Tree a -> Tree a
appendTree Empty Empty = Empty
appendTree left Empty = left
appendTree Empty right = right
appendTree left right =
    let a = f . findMin $ right
    in Node a left (delete a right)

findMin :: (Ord a) => Tree a -> Maybe a
findMin Empty = Nothing
findMin (Node a Empty Empty) = Just a
findMin (Node _ left _) = findMin left

f :: Maybe a -> a
f Nothing = undefined
f (Just x) = x

入出力結果(Terminal, runghc)

$ runghc Sample.hs
Empty
Node "Int" Empty Empty
Node "Int" (Node "Double" Empty Empty) Empty
Node "Int" (Node "Double" (Node "Char" Empty Empty) Empty) Empty
Node "Int" (Node "Double" (Node "Char" Empty Empty) Empty) (Node "String" Empty Empty)
True
True
True
False
Node "Int" (Node "Double" (Node "Char" Empty Empty) Empty) (Node "String" Empty Empty)
Node "String" (Node "Double" (Node "Char" Empty Empty) Empty) Empty
Node "String" (Node "Char" Empty Empty) Empty
Node "String" Empty Empty
Empty
$

慣れるまでは{-# OPTIONS -Wall -Werror #-}の記述を消さずに細かく型を指定していくことに。