[ pred x | x <- "Ibtlfmm!ojllj" ]

WindowsのGHC 6.10.2でのGLUTバインディングのビルド

02:45

6.10になってからか、なぜかGHCにOpenGLが付属しなくなった。

試してみたら(運よく)できたのでメモしておく。

• 必要なもの
  • Git(に同梱のMSYSのsh.exe)
  • Visual C++ (cl.exe)
  • Microsoft Platform SDK (gl.hなどのため)
  • GLUTバイナリ (glut.hなどのため)
  • GLUTバインディングのソース (http://hackage.haskell.org/package/GLUT のtar.gz)
  • OpenGLバインディングのソース (http://hackage.haskell.org/package/OpenGL のtar.gz)

clを使わなくともghcに付属のMinGW gccで出来ればいいと思うのだが、単純に試してもうまくいかなかった。

OpenGLバインディングをビルド

コマンドプロンプトでコンパイルする。

Platform SDKをC:\PROGRA~1\MIC977~1にインストールしたとする。

• c:\program files\git\binにpathを通しておく
• OpenGL.cabalに追記

extra-libraries: opengl32, glu32
extra-lib-dirs: C:\PROGRA~1\MIC977~1\Lib
extra-include-dirs: C:\PROGRA~1\MIC977~1\Include

• runghc Setup.hs configure -p
• runghc Setup.hs build
  • うまくいけばそれに越したことはない
• buildがうまくいかなければ、include\HsOpenGLConfig.hに追記
  • 内容は検索して拾ってきたもの

#define HTYPE_GLBITFIELD Word32
#define HTYPE_GLBOOLEAN Word8
#define HTYPE_GLBYTE Int8
#define HTYPE_GLCLAMPD Double
#define HTYPE_GLCLAMPF Float
#define HTYPE_GLDOUBLE Double
#define HTYPE_GLENUM Word32
#define HTYPE_GLFLOAT Float
#define HTYPE_GLINT Int32
#define HTYPE_GLSHORT Int16
#define HTYPE_GLSIZEI Int32
#define HTYPE_GLUBYTE Word8
#define HTYPE_GLUINT Word32
#define HTYPE_GLUSHORT Word16

• runghc Setup.hs install

GLUTバインディングをビルド

GLUTのバイナリはC:\local\glut-3.7.6-binに置いたものとする。

• GLUT.cabalに追記 (行頭の空白含む)

  extra-libraries: glut32
  extra-lib-dirs: C:\local\glut-3.7.6-bin

• runghc Setup.hs configure -p
• runghc Setup.hs build
• runghc Setup.hs install

うまくいってるか確認

GLUT-2.1.2.1\examples\RedBookにいろいろサンプルがあるのでrunghcしてみる。

ベクトルの足し算をControl.Applicativeで

01:12

• http://gist.github.com/128742 (履歴つき)

data Vector2 a = Vector2 a a deriving (Show, Eq)

こういう型をNumのinstanceにすることを考える。単純に書くとこうだ。

instance Num a => Num (Vector2 a) where
  Vector2 x y + Vector2 x' y' = Vector2 (x + x') (y + y')
  Vector2 x y - Vector2 x' y' = Vector2 (x - x') (y - y')
  Vector2 x y * Vector2 x' y' = Vector2 (x * x') (y * y')
  negate (Vector2 x y) = Vector2 (-x) (-y)
  abs (Vector2 x y) = Vector2 (abs x) (abs y)
  signum (Vector2 x y) = Vector2 (signum x) (signum y)
  fromInteger x = Vector2 (fromInteger x) (fromInteger x)

掛け算などの定義には突っ込まないでほしい。僕はVector 1 2 + Vector 3 4と書きたいだけなのだ。

上だけなら対した量ではないが、Vector3やVector4を実装するとなると、コピぺしていじる作業が辛くなってくる。

この状況を改善したい。

fmapを使う

fmapを使うとすこし楽になる。

instance Functor Vector2 where
  fmap f (Vector2 x y) = Vector2 (f x) (f y)

instance Num a => Num (Vector2 a) where
  Vector2 x y + Vector2 x' y' = Vector2 (x + x') (y + y')
  Vector2 x y - Vector2 x' y' = Vector2 (x - x') (y - y')
  Vector2 x y * Vector2 x' y' = Vector2 (x * x') (y * y')
  negate = fmap negate
  abs = fmap abs
  signum = fmap signum
  fromInteger x = fmap fromInteger (Vector2 x x)

とはいえ、足し算や引き算は変わらない。

fmap2がほしい

パターンはこうだ。

Vector2 x y `op` Vector2 x' y' = Vector2 (x `op` x') (y `op` y')

そのままこれを関数とするとこうなる。

op :: (a -> b -> c) -> Vector2 a -> Vector2 b -> Vector2 c
op f (Vector2 x y) (Vector2 x' y') = Vector2 (x `f` x') (y `f` y')

これを使うとこう定義できる。

instance Num a => Num (Vector2 a) where
  (+) = op (+)
  (-) = op (-)
  (*) = op (*)
  negate = fmap negate
  abs = fmap abs
  signum = fmap signum
  fromInteger x = fmap fromInteger (Vector2 x x)

opはfmapの二引数関数用と言ってもいい。こういうクラスと関数があってもいいはずだ。

class Functor2 f where
  fmap2 :: (a -> b -> c) -> f a -> f b -> f c

-- で

instance Functor2 Vector2 where
  fmap2 = op

instance Num a => Num (Vector2 a) where
  (+) = fmap2 (+)
  (-) = fmap2 (-)
  (*) = fmap2 (*)
  negate = fmap negate
  abs = fmap abs
  signum = fmap signum
  fromInteger x = fmap fromInteger (Vector2 x x)

fmap2は標準に含まれていない。

liftA2

fmap2は無いが、幸いなことにControl.Applicativeで用が足りる。

liftA2 :: (Applicative f) => (a -> b -> c) -> f a -> f b -> f c

つまり、Vector2をApplicativeのinstanceにすればこの関数が使える。

instance Applicative Vector2 where
  pure x = Vector2 x x
  Vector2 fx fy <*> Vector2 x y = Vector2 (fx x) (fy y)

instance Functor Vector2 where
  fmap = liftA

instance Num a => Num (Vector2 a) where
   (+) = liftA2 (+)
   (-) = liftA2 (-)
   (*) = liftA2 (*)
   negate = fmap negate
   abs = fmap abs
   signum = fmap signum
   fromInteger = pure . fromInteger

これで重複が少なくなり、コピペしやすいコードになった。(ついでにfromIntegerもpureで書き換えた)

liftA2はFractionalの実装にもそのまま使える。

instance (Fractional a) => Fractional (Vector2 a) where
   (/) = liftA2 (/)
   recip = fmap recip
   fromRational = pure . fromRational

副産物

ここまで実装すると不思議なことが起こる。Vectorが割れるのだ。

GHCi, version 6.10.2: http://www.haskell.org/ghc/  :? for help
Loading package ghc-prim ... linking ... done.
Loading package integer ... linking ... done.
Loading package base ... linking ... done.
[1 of 1] Compiling Main             ( va.hs, interpreted )
Ok, modules loaded: Main.
*Main> Vector2 3 4 / 5
Vector2 0.6 0.8
*Main> Vector2 3 4 * 3
Vector2 9 12

これは数字リテラルがオーバーロードされていることによる。

*Main> :t 5
5 :: (Num t) => t
*Main> 5 :: Vector2 Int
Vector2 5 5

こちらはすこし気持ち悪いかもしれない。

*Main> Vector2 1.5 2 + (-3.2)
Vector2 (-1.7000000000000002) (-1.2000000000000002)
*Main> Vector2 (-3) 1.9 - 4
Vector2 (-7.0) (-2.1)

Control.MonadをApplicativeで

16:50

d:id:Otter_O:20080301:1204363038を見て、Control.Monadにあるユーティリティ関数をApplicativeで書き換えてみた。

• http://gist.github.com/125235

21個中15個を書き換えることが出来た。

(=<<) :: Monad m => (a -> m b) -> m a -> m b
(>=>) :: Monad m => (a -> m b) -> (b -> m c) -> a -> m c
(<=<) :: Monad m => (b -> m c) -> (a -> m b) -> a -> m c
join :: Monad m => m (m a) -> m a
foldM :: Monad m => (a -> b -> m a) -> a -> [b] -> m a
foldM_ :: Monad m => (a -> b -> m a) -> a -> [b] -> m ()

これらは実行の結果を受け渡す機能が必要なので実装できなかった。

else if

22:37

ifのインデント関係は微妙だ。

以下はコンパイルが通るが、

a :: Maybe Int
a =
  if True
  then return 3
  else if False
  then return 6
  else return 4

以下はエラーになる。

a :: Maybe Int
a = do
  if True
  then return 3
  else if False
  then return 6
  else return 4

でもこれは通る。

a :: Maybe Int
a = do
  if True
    then return 3
    else if False
    then return 6
    else return 4

一貫性を重視するとこう。

a :: Maybe Int
a = do
  if True
    then return 3
    else if False
      then return 6
      else return 4

こういう場合case文で書くというイディオムがあるらしい。

a :: Maybe Int
a = do
  case () of
    _ | True -> return 3
      | False -> return 6
      | otherwise -> return 4

condに似たものを感じる。

(このcaseによる書き方を紹介しようと思って書き始めたが、インデントの深さでいうと3つ目のほうがいい気がしてきた)

ジェネレータ

ライブラリ | 16:04

• PauseMonad.hs
• YieldMonad.hs

PythonやRubyのジェネレータのような仕組みを提供するモナドを書いた。

YieldモナドがあればPauseモナドはいらない。

import PauseMonad

main :: IO ()
main = tracePauseT $ do
  liftIO $ print 1
  pause
  liftIO $ print 2
  pause
  liftIO $ print 3
  pause
  liftIO $ print 4

import YieldMonad

main :: IO ()
main = traceYieldT $ do
  liftIO $ print 1
  yield "hoge"
  liftIO $ print 2
  yield "fuga"
  liftIO $ print 3
  yield "foo"
  liftIO $ print 4