eagletmtの日記

FFI を利用する (1)

Haskell | 18:14 |

例として libxml を利用して html をパースしたり XPath を使ってみたりするコードを書いてみる．

ちなみに Haskell で XML を扱うライブラリとしては HaXml や hxt がある．

主に RWH 17章 と 本物のプログラマはHaskellを使う - 本物のプログラマはHaskellを使う：ITpro の第22-23回を参考にした．

import 文を毎回書くのがだるいので

import Control.Applicative ((<$>))
import Control.Exception (bracket)
import Data.Bits ((.|.))
import System.IO.Unsafe (unsafePerformIO)
import Foreign.Ptr (Ptr, nullPtr)
import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
import Foreign.Concurrent (newForeignPtr)
import Foreign.C.String (CString, withCString)
import Foreign.C.Types (CInt)
import Foreign.Storable (peekByteOff)
import Foreign.Marshal.Array (peekArray)
import qualified Data.ByteString as B

あたりを補ってください．

メモリ上にある文字列を html としてパースするには htmlReadMemory が使える．

まずはこれを Haskell の関数としてラップする．

htmlDocPtr (xmlDocPtr) という型の値が返されるので，これを Haskell の型に翻訳しなければならない．

これを実現するために，以下のようにデータ構築子の無いデータ型を利用する方法がよく使われる．

data XmlDocTag
newtype XmlDoc = MkXmlDoc (Ptr XmlDocTag)

さらに XmlDoc でラップすることで，この型だけを外に公開することで opaque なデータ型を表現している．

すると，C の htmlReadMemory はこのように型付けできる．

foreign import ccall "htmlReadMemory" c_htmlReadMemory :: CString -> CInt -> CString -> CString -> CInt -> IO (Ptr XmlDocTag)

htmlReadMemory は htmlDocPtr の領域を確保してそれを返すので IO 型とする必要がある．

foreign import された C の関数には プレフィックスとして c_ をつけるのが慣習らしい．

htmlReadMemory をラップした parseHTML の型として最初に

parseHTML :: B.ByteString -> String -> String -> Int -> IO XmlDoc

を考える．

String → CString の変換には withCString，ByteString → (CString,Int) の変換には useAsCStringLen が使える．

本体の定義はこんなかんじ．

parseHTML src url encoding opt = do
  ptr <- B.useAsCStringLen src $
          \(cstr,len) -> withCString encoding $
            \e -> withCString url $
              \u -> c_htmlReadMemory cstr (fromIntegral len) e u (fromIntegral opt)
  return $ MkXmlDoc ptr

しかしよく考えてみると parseHTML は参照透明だし，Haskell から見て IO 型である必要はない．

そこで unsafePerformIO を使って IO を外してやるとよい．

unsafePerformIO は無闇に使うと危険だが，ここでは安全…なはず．

parseHTML :: B.ByteString -> String -> String -> Int -> XmlDoc
parseHTML src url encoding opt = unsafePerformIO $ do
  ptr <- B.useAsCStringLen src $
          \(cstr,len) -> withCString encoding $
            \e -> withCString url $
              \u -> c_htmlReadMemory cstr (fromIntegral len) e u (fromIntegral opt)
  return $ MkXmlDoc ptr

次に問題になるのは，ここで確保された Ptr XmlDocTag のメモリ領域はいつどのようにして解放すべきかということだ．

これを解放するのは C の xmlFreeDoc の仕事で，C のコードでは xmlDocPtr が不必要になった時点でプログラマの責任で xmlFreeDoc を呼んで解放する．

Haskell 上でも同様の方法をとってもいいが，自分で解放するのは面倒だしわざわざ IO アクションを必要とするのもアレなので処理系に任せたい．

Haskell の外で確保されたメモリを保持する場合は ForeignPtr 利用する．

ForeignPtr 型を作るには newForeignPtr が使いやすい．

newForeignPtr の2つ目の引数にファイナライズに必要な IO アクションを渡すと，Haskell の GC によって破棄されるときにこれが呼ばれるようになる．

data XmlDocTag
newtype XmlDoc = MkXmlDoc (ForeignPtr XmlDocTag)

parseHTML :: B.ByteString -> String -> String -> Int -> XmlDoc
parseHTML src url encoding opt = unsafePerformIO $ do
  ptr <- B.useAsCStringLen src $
          \(cstr,len) -> withCString encoding $
            \e -> withCString url $
              \u -> c_htmlReadMemory cstr (fromIntegral len) e u (fromIntegral opt)
  fptr <- newForeignPtr ptr $ c_xmlFreeDoc ptr
  return $ MkXmlDoc fptr

newForeignPtr ptr $ c_xmlFreeDoc ptr >> putStrLn "free"

などとして，parseHTML を10000回くらい呼んでみると実際にファイナライザが呼ばれていることを確認できると思う．

ForeignPtr を Ptr として使うときには withForeignPtr を使う．

FFI を利用する (2) hsc2hs

Haskell | 18:14 |

FFI とは直接関係は無いが，もう少し Haskell から使いやすい関数にしてみる．

定数オプション

まず htmlReadMemory に渡す定数オプションをそのまま数値として渡すのは使いにくい．

そこで hsc2hs を利用してもうちょっとわかりやすい形で指定できるようにする．

#include <libxml/HTMLparser.h>
newtype HtmlParserOption = HtmlParserOption { unHtmlParserOption :: CInt }
#{enum HtmlParserOption, HtmlParserOption
  , recover = HTML_PARSE_RECOVER
  , noError = HTML_PARSE_NOERROR
  , noWarning = HTML_PARSE_NOWARNING
  , pedantic = HTML_PARSE_PEDANTIC
  , noBlanks = HTML_PARSE_NOBLANKS
  , noNet = HTML_PARSE_NONET
  , noImplied = HTML_PARSE_NOIMPLIED
  , compact = HTML_PARSE_COMPACT
  }

foldOpts :: [HtmlParserOption] -> CInt
foldOpts = foldl (\a -> (a .|. ) . unHtmlParserOption) 0

data XmlDocTag
newtype XmlDoc = MkXmlDoc (ForeignPtr XmlDocTag)

parseHTML :: B.ByteString -> String -> String -> [HtmlParserOption] -> XmlDoc
parseHTML src url encoding opts = unsafePerformIO $ do
  ptr <- B.unsafeUseAsCStringLen src $
          \(cstr,len) -> withCString encoding $
            \e -> withCString url $
              \u -> c_htmlReadMemory cstr (fromIntegral len) e u (foldOpts opts)
  fptr <- newForeignPtr ptr $ c_xmlFreeDoc ptr
  return $ MkXmlDoc fptr
foreign import ccall "htmlReadMemory" c_htmlReadMemory :: CString -> CInt -> CString -> CString -> CInt -> IO (Ptr XmlDocTag)
foreign import ccall "xmlFreeDoc" c_xmlFreeDoc :: Ptr XmlDocTag -> IO ()

こんなかんじに LibXml.hsc に書いて

% hsc2hs `xml2-config --cflags` LibXml.hsc

とすると LibXml.hs が生成されて，recover, noError といった定数が適切に定義されている．

NULL と Maybe

ドキュメントによると htmlReadMemory の encoding は特に指定しないときは NULL を渡すらしい．

C のライブラリではこのような仕様の関数がよくある．

これを Haskell で表現するには Maybe が適当だろう．

ユーティリティとして

withMaybeCString :: Maybe String -> (CString -> IO a) -> IO a
withMaybeCString (Just str) act = withCString str act
withMaybeCString Nothing act = act nullPtr

なんかを定義して

parseHTML :: B.ByteString -> String -> Maybe String -> [HtmlParserOption] -> XmlDoc
parseHTML src url encoding opts = unsafePerformIO $ do
  ptr <- B.unsafeUseAsCStringLen src $
          \(cstr,len) -> withMaybeCString encoding $
            \e -> withCString url $
              \u -> c_htmlReadMemory cstr (fromIntegral len) e u (foldOpts opts)
  fptr <- newForeignPtr ptr $ c_xmlFreeDoc ptr
  return $ MkXmlDoc fptr

とするとよさそう．

さらに XmlDoc から文字列として XPath で指定した要素を返す関数として

xpath :: String -> XmlDoc -> Maybe ([Node],Int)

を定義してみる．

libxml 側の API としては http://www.xmlsoft.org/html/libxml-xpath.html にあるものを使う．

data NodeTag
newtype Node = MkNode (Ptr NodeTag)
data NodeSetTag
data XPathContextTag
data XPathObjectTag

xpath :: String -> XmlDoc -> Maybe ([Node],Int)
xpath s (MkXmlDoc docPtr) = unsafePerformIO $ do
  ctx <- withForeignPtr docPtr c_xmlXPathNewContext
  obj <- withCString s (`c_xmlXPathEvalExpression` ctx)
  if obj == nullPtr
    then return Nothing
    else do
      nodes <- (#peek xmlXPathObject, nodesetval) obj :: IO (Ptr NodeSetTag)
      if nodes == nullPtr
        then c_xmlXPathFreeObject obj >> return Nothing
        else do
          nr <- fromIntegral <$> ((#peek xmlNodeSet, nodeNr) nodes :: IO CInt)
          tab <- (#peek xmlNodeSet, nodeTab) nodes :: IO (Ptr (Ptr NodeTag))
          ns <- map MkNode <$> peekArray nr tab
          c_xmlXPathFreeObject obj
          return $ Just (ns,nr)
foreign import ccall "xmlXPathNewContext" c_xmlXPathNewContext :: Ptr XmlDocTag -> IO (Ptr XPathContextTag)
foreign import ccall "xmlXPathEvalExpression" c_xmlXPathEvalExpression :: CString -> Ptr XPathContextTag -> IO (Ptr XPathObjectTag)
foreign import ccall "xmlXPathFreeObject" c_xmlXPathFreeObject :: Ptr XPathObjectTag -> IO ()

NULL でエラーチェックとか懐しいですね!!

構造体のメンバにアクセスするには hsc2hs の機能を使って (#peek struct_type, member_name) で行える．

C の配列をリストとして Haskell の表現に直すときには peekArray が便利．

FFI を利用する (3) C でラッパを書く

Haskell | 18:14 |

Node だけとれてもしょうがないので，例えばそのノードの textContent を得る関数を定義してみる．

libxml の API では xmlNodeGetContent にあたる．

textContent :: Node -> B.ByteString
textContent (MkNode ptr) = unsafePerformIO $
  bracket (c_xmlNodeGetContent ptr) c_xmlFree B.packCString
foreign import ccall "xmlNodeGetContent" c_xmlNodeGetContent :: Ptr NodeTag -> IO CString
foreign import ccall "xmlFree" c_xmlFree :: Ptr a -> IO ()

これでうまくいってくれればよかったのだけど，なぜか c_xmlFree で落ちる．

libxml/globals.h を見るとなんか #define とかされているようだけど，具体的になぜ失敗するのかよくわからない…

しょうがないので xmlFree を呼ぶだけのラッパを C のほうで書いてそれを呼んだらうまくいった．

#include <libxml/globals.h>

void xmlFree_wrap(void *mem)
{
  xmlFree(mem);
}

ビルドするときは

% gcc -c `xml2-config --cflags` wrapper.c

とコンパイルして，最終的に ghc に wrapper.o も一緒に渡してやればよい．

FFI を利用する (4)

Haskell | 18:14 |

最終的なコードと利用サンプル，そしてそれらをビルドする cabal ファイルを最後に載せておく．

libxml.cabal

Name: libxml
Version: 0.1
License: BSD3
Category: Text
Build-type: Simple
Cabal-version: >=1.6

Executable sample
  Main-is: Main.hs
  Other-Modules: LibXml
  Build-depends: base == 4.*, bytestring
  Build-tools: hsc2hs
  Hs-source-dirs: src
  Includes: wrapper.h
  Include-dirs: include
  C-sources: cbits/wrapper.c
  Extra-libraries: xml2

src/LibXml.hsc

{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}
module LibXml (
    HtmlParserOption, recover, noError, noWarning, pedantic, noBlanks, noNet, noImplied, compact
  , XmlDoc, Node
  , parseHTML
  , xpath
  , textContent
  ) where
#include <libxml/HTMLparser.h>
#include <libxml/xpath.h>

import Control.Applicative ((<$>))
import Control.Exception (bracket)
import Data.Bits ((.|.))

import System.IO.Unsafe (unsafePerformIO)
import Foreign.Ptr (Ptr, nullPtr)
import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
import Foreign.C.String (CString, withCString)
import Foreign.C.Types (CInt)
import Foreign.Concurrent (newForeignPtr)
import Foreign.Storable (peekByteOff)
import Foreign.Marshal.Array (peekArray)
import qualified Data.ByteString as B

data XmlDocTag
newtype XmlDoc = MkXmlDoc (ForeignPtr XmlDocTag)
data NodeTag
newtype Node = MkNode (Ptr NodeTag)
data NodeSetTag
data XPathContextTag
data XPathObjectTag

newtype HtmlParserOption = HtmlParserOption { unHtmlParserOption :: CInt }
#{enum HtmlParserOption, HtmlParserOption
  , recover = HTML_PARSE_RECOVER
  , noError = HTML_PARSE_NOERROR
  , noWarning = HTML_PARSE_NOWARNING
  , pedantic = HTML_PARSE_PEDANTIC
  , noBlanks = HTML_PARSE_NOBLANKS
  , noNet = HTML_PARSE_NONET
  , noImplied = HTML_PARSE_NOIMPLIED
  , compact = HTML_PARSE_COMPACT
  }

foldOpts :: [HtmlParserOption] -> CInt
foldOpts = foldl (\a -> (a .|. ) . unHtmlParserOption) 0

withMaybeCString :: Maybe String -> (CString -> IO a) -> IO a
withMaybeCString (Just str) act = withCString str act
withMaybeCString Nothing act = act nullPtr

parseHTML :: B.ByteString -> String -> Maybe String -> [HtmlParserOption] -> XmlDoc
parseHTML src url encoding opts = unsafePerformIO $ do
  ptr <- B.useAsCStringLen src $
          \(cstr,len) -> withMaybeCString encoding $
            \e -> withCString url $
              \u -> c_htmlReadMemory cstr (fromIntegral len) e u (foldOpts opts)
  fptr <- newForeignPtr ptr $ c_xmlFreeDoc ptr
  return $ MkXmlDoc fptr
foreign import ccall "htmlReadMemory" c_htmlReadMemory :: CString -> CInt -> CString -> CString -> CInt -> IO (Ptr XmlDocTag)
foreign import ccall "xmlFreeDoc" c_xmlFreeDoc :: Ptr XmlDocTag -> IO ()

xpath :: String -> XmlDoc -> Maybe ([Node],Int)
xpath s (MkXmlDoc docPtr) = unsafePerformIO $ do
  ctx <- withForeignPtr docPtr c_xmlXPathNewContext
  obj <- withCString s (`c_xmlXPathEvalExpression` ctx)
  if obj == nullPtr
    then return Nothing
    else do
      nodes <- (#peek xmlXPathObject, nodesetval) obj :: IO (Ptr NodeSetTag)
      if nodes == nullPtr
        then c_xmlXPathFreeObject obj >> return Nothing
        else do
          nr <- fromIntegral <$> ((#peek xmlNodeSet, nodeNr) nodes :: IO CInt)
          tab <- (#peek xmlNodeSet, nodeTab) nodes :: IO (Ptr (Ptr NodeTag))
          ns <- map MkNode <$> peekArray nr tab
          c_xmlXPathFreeObject obj
          return $ Just (ns,nr)
foreign import ccall "xmlXPathNewContext" c_xmlXPathNewContext :: Ptr XmlDocTag -> IO (Ptr XPathContextTag)
foreign import ccall "xmlXPathEvalExpression" c_xmlXPathEvalExpression :: CString -> Ptr XPathContextTag -> IO (Ptr XPathObjectTag)
foreign import ccall "xmlXPathFreeObject" c_xmlXPathFreeObject :: Ptr XPathObjectTag -> IO ()

textContent :: Node -> B.ByteString
textContent (MkNode ptr) = unsafePerformIO $
  bracket (c_xmlNodeGetContent ptr) c_xmlFree B.packCString
foreign import ccall "xmlNodeGetContent" c_xmlNodeGetContent :: Ptr NodeTag -> IO CString
foreign import ccall "xmlFree_wrap" c_xmlFree :: Ptr a -> IO ()

include/wrapper.h

#ifndef LIBXML_WRAPPER_H
#define LIBXML_WRAPPER_H
void xmlFree_wrap(void *mem);
#endif

cbits/wrapper.c

#include <libxml/globals.h>
#include "wrapper.h"

void xmlFree_wrap(void *mem)
{
  xmlFree(mem);
}

src/Main.hs

{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Monad (forM_)
import System.Environment (getArgs)
import qualified Data.ByteString.Char8 as B8
import LibXml

main :: IO ()
main = do
  args <- getArgs
  forM_ args $ \path -> do
    str <- B8.readFile path
    let doc = parseHTML str "" (Just "UTF-8") [recover, noError, noWarning, noNet]
    case xpath "//a[@href]" doc of
      Nothing -> putStrLn $ path ++ ": failed"
      Just (ns,nr) -> putStrLn (path ++ ": " ++ show nr ++ " nodes") >> mapM_ (B8.putStrLn . B8.append "  " . textContent) ns

HXT の練習

00:03 |

hxt-9.1.0: A collection of tools for processing XML with Haskell. とか HXT - HaskellWiki を見ながらがんばる．

コンセプトは HaXml と同様にフィルタの組み合わせなんだけど，読み込みや書き込みも含めてすべて Arrow で繋げる．

IO を伴わない場合は [State]ListArrow ([S]LA)，伴う場合は IO[State]ListArrow (IO[S]LA) を使うかんじでいいのかな．

引数として与えた screen_name のユーザのふぁぼり最新20をいいかんじに table に変換して出力するもの書いた．

それぞれのユーザ毎に API 1つ消費．

toString とか prepare とか醜い…

import Prelude hiding (id)
import Control.Monad (forM_)
import System.Environment (getArgs)
import qualified System.IO.UTF8 as U
import Text.XML.HXT.Arrow
import Data.Tree.NTree.TypeDefs (NTree)

data Status = S {text :: String, id :: String, name :: String, imgurl :: String}

toString :: LA [a] XmlTree -> String
toString a = head $ runLA (selem "dummy" [a] >>> xshow getChildren) []

main = do
  users <- getArgs
  forM_ users $ \u -> do
    elems <- runX $ readDocument [] ("http://twitter.com/favorites/" ++ u ++ ".xml") >>> deep (isElem >>> hasName "status")

    putStrLn "<table border=\"1\" bgcolor=\"#FFFFFF\">"
    mapM_ (U.putStrLn . toString . prepare . parse) elems
    putStrLn "</table>"

parse :: NTree XNode -> Status
parse s = let get e n = head $ runLA (getChildren >>> hasName n >>> getChildren >>> getText) e
              [text, id] = map (get s) ["text", "id"]
              [name, imgurl] = map (get (head $ runLA (getChildren >>> hasName "user") s)) ["screen_name", "profile_image_url"]
          in S text id name imgurl

prepare :: (ArrowXml a) => Status -> a n XmlTree
prepare s = mkelem "tr" [sattr "width" "32", sattr "height" "32"]
              [ mkelem "td" [sattr "width" "32", sattr "height" "32"] [mkelem "img" [sattr "src" (imgurl s), sattr "width" "32", sattr "height" "32"] []]
              , selem "td" [mkelem "a" [sattr "href" ("http://twitter.com/" ++ name s)] [txt (name s)]]
              , selem "td" [txt (text s)]
              , selem "td" [mkelem "a" [sattr "href" ("http://twitter.com/" ++ name s ++ "/status/" ++ id s)] [txt "link"]]]

HTML 生成は moe のほうが数段読み書きしやすいですね…

GHC API で型を表示

GHC | 21:11 |

GHC API 全般的には，GhcMonad の中でごにょごにょやって runGhc で実行するかんじ．

デフォルトの GhcMonad のインスタンスは Ghc．モナド変換子バージョンの GhcT も用意されている．

Prelude を import して型を表示するようなコードを書いてみた．

http://hpaste.org/fastcgi/hpaste.fcgi/view?id=10634

findModule して Module を得て，setContext でそのモジュールを使えるようにして，exprType で Type を得る，という流れ．

GHCi で :type したときとほぼ同じ処理と思われる．

参考

http://www.haskell.org/haskellwiki/GHC/As_a_library

http://www.haskell.org/ghc/docs/latest/html/libraries/ghc/GHC.html

型レベル FizzBuzz

10:18 |

元ネタ: http://d.hatena.ne.jp/bleis-tift/20090929/1254185496

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances, FlexibleInstances #-}
{-# LANGUAGE EmptyDataDecls #-}

data Z
data S n
data Yes
data No
data Nil
data Cons x xs

u = undefined

-- (<)
class Le a b c | a b -> c where
  le :: a -> b -> c
  le = u
instance Le Z Z Yes
instance Le Z (S b) Yes
instance Le (S n) Z No
instance Le a b c => Le (S a) (S b) c

class Equal n m b | n m -> b where
instance Equal Z Z Yes
instance Equal Z (S m) No
instance Equal (S n) Z No
instance Equal n m b => Equal (S n) (S m) b

class Add x y z | x y -> z where
  add :: x -> y -> z
  add = u
instance Add Z y y
instance Add x y z => Add (S x) y (S z)

class Sub x y z | x y -> z where
  sub :: x -> y -> z
  sub = u
instance Sub x Z x
instance Sub x y z => Sub (S x) (S y) z

class Mult x y z | x y -> z where
  mult :: x -> y -> z
  mult = u
instance Mult Z y Z
instance (Mult x y z, Add y z r) => Mult (S x) y r

class Divisible x y r | x y -> r where
  divisible :: x -> y -> r
  divisible = u
instance (Le y x b, Divisible' b x y r) => Divisible x y r
class Divisible' b x y r | b x y -> r
instance (Sub x y z, Divisible z y r) => Divisible' Yes x y r
instance Equal x Z r => Divisible' No x y r

data Fizz
data Buzz
data FizzBuzz

class ToFizzBuzz n f | n -> f where
  toFizzBuzz :: n -> f
  toFizzBuzz = u
instance (Divisible n Fifteen b, ToFizzBuzz' b n f) => ToFizzBuzz n f
class ToFizzBuzz' b n r | b n -> r
instance ToFizzBuzz' Yes n FizzBuzz
instance (Divisible n Five b, ToFizzBuzz'' b n f) => ToFizzBuzz' No n f
class ToFizzBuzz'' b n f | b n -> f
instance ToFizzBuzz'' Yes n Buzz
instance (Divisible n Three b, ToFizzBuzz''' b n f) => ToFizzBuzz'' No n f
class ToFizzBuzz''' b n f | b n -> f
instance ToFizzBuzz''' Yes n Fizz
instance ToFizzBuzz''' No n n

class FizzBuzzList n xs | n -> xs where
  fizzBuzzList :: n -> xs
  fizzBuzzList n = u
instance FizzBuzzList' n (S Z) xs => FizzBuzzList n xs
class FizzBuzzList' n m xs | n m -> xs
instance (Equal n m b, FizzBuzzList'' b n m xs) => FizzBuzzList' n m xs
class FizzBuzzList'' b n m xs | b n m -> xs
instance (ToFizzBuzz m f) => FizzBuzzList'' Yes n m (Cons f Nil)
instance (FizzBuzzList' n (S m) xs, ToFizzBuzz m f) => FizzBuzzList'' No n m (Cons f xs)

type One = S Z
type Two = S One
type Three = S Two
type Four = S Three
type Five = S Four
type Six = S Five
type Seven = S Six
type Eight = S Seven
type Nine = S Eight
type Ten = S Nine
type Fifteen = S (S (S (S (S Ten))))
three :: Three
three = u
four :: Four
four = u
five :: Five
five = u
six :: Six
six = u
fifteen = mult three five
thirty = mult five six

長い…

Add, Mult は直接は関係無いが，fifteen や thirty を定義するのに便利だから入れてある．

toFizzBuzz を定義してあるので，まずはそれで確認してみる．

*Main> :t toFizzBuzz (u::One)
toFizzBuzz (u::One) :: S Z
*Main> :t toFizzBuzz (u::Two)
toFizzBuzz (u::Two) :: S One
*Main> :t toFizzBuzz (u::Three)
toFizzBuzz (u::Three) :: Fizz
*Main> :t toFizzBuzz (u::Four)
toFizzBuzz (u::Four) :: S Three
*Main> :t toFizzBuzz (u::Five)
toFizzBuzz (u::Five) :: Buzz
*Main> :t toFizzBuzz (u::Six)
toFizzBuzz (u::Six) :: Fizz
...
*Main> :t toFizzBuzz (u::Fifteen)
toFizzBuzz (u::Fifteen) :: FizzBuzz

で，FizzBuzz なリストを出力してみる．

% ghc -isrc fizzbuzz.hs -e ':t fizzBuzzList fifteen'

実行結果: http://tinypaste.com/431bbd3

さらに30まで．

% ghc -isrc fizzbuzz.hs -e ':t fizzBuzzList thirty'
Top level:
    Context reduction stack overflow; size = 20
    Use -fcontext-stack=N to increase stack size to N
(snip)

こんなエラー初めて見た…

というわけで指示通りに．

% ghc -isrc fizzbuzz.hs -fcontext-stack=35 -e ':t fizzBuzzList thirty'

実行結果: http://tinypaste.com/be404

追記

@shelarcy

@lazyeagle ああ、Haskellの話でしたか。UndecidableInstancesを使って弱められた制限の下では型推論が終了しなくなる（無限ループに陥る）可能性があるため、GHCではわざと再帰スタックの深さに対して制限をかけていますhttp://www.haskell.org/ghc/docs/6.10.4/html/users_guide/type-class-extensions.html#undecidable-instances

link

GHC の User's Guide のとこにまさにそのことが書いてありましたね．

Termination is ensured by having a fixed-depth recursion stack. If you exceed the stack depth you get a sort of backtrace, and the opportunity to increase the stack depth with -fcontext-stack=N.

ここにはデフォルトの値が書かれていないけど，実行結果からどうやら20らしい．

Haskell で Brainf*ck interpreter

22:38 |

そういえば書いたことなかったなぁということで．

http://github.com/eagletmt/bf-interp

引数が与えられたらそのファイルから，与えられなかったら標準入力から Brainf*ck を読み込んで実行する．

Status 型を作ったり StateT で実行させたりしてるけど，どうしても C とかで書くより煩雑になってしまいますね…

tape が Word8 型なのは 0 のデクリメントの結果を 255，255 のインクリメントの結果を 0 にしたかったから．

なぜそうなってほしかったかというと，まぁ普段使ってる Brainf*ck インタープリタに合わせたかったからです．

Begin や End にジャンプする相対的な距離を入れてあるけど，例えば optimize :: [BFInsn] -> [BFInsn] みたいな最適化する関数を書いたときに扱いがめんどくさいかなぁと思ってる．