Hatena::Grouphaskell

eagletmtの日記 このページをアンテナに追加

 | 

2009-09-30

型レベル FizzBuzz

10:18 | 型レベル FizzBuzz - eagletmtの日記 を含むブックマーク はてなブックマーク - 型レベル FizzBuzz - eagletmtの日記 型レベル FizzBuzz - eagletmtの日記 のブックマークコメント

元ネタ: 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らしい.

TracyTracy2013/03/31 21:36Articles like this really grease the sfhats of knowledge.

sbtfihoqisbtfihoqi2013/04/04 14:267a7NAH <a href="http://tfbfnqvqihef.com/">tfbfnqvqihef</a>

fjcktgzfjcktgz2013/04/04 20:18xjbG37 , [url=http://cfemoqsiulgr.com/]cfemoqsiulgr[/url], [link=http://uzxujjpcyfzd.com/]uzxujjpcyfzd[/link], http://idmfmlyrbyga.com/

PhilipjepPhilipjep2017/04/12 04:36http://stemmeries.xyz <a href="http://stemmeries.xyz">norsk kasino</a> http://stemmeries.xyz - norsk kasino

トラックバック - http://haskell.g.hatena.ne.jp/eagletmt/20090930
 |