型エラーとして FizzBuzz を出力
GHC で以下のコードをコンパイルしようとすると,型エラーとして FizzBuzz 的なものが出力されます.
出力を見やすくしようとして Template Haskell を使ったら比較的最近の GHC でないとコンパイルできなくなってしまった…
手元の GHC (7.0.3) だと OK で,ideone の GHC (6.8.2) だとダメ*1だった.
#define N 30
のところでいくつまで出力するかを決めている.
N を大きくしたら -fcontext-stack の値も大きくしないと別のエラーが出る.
{-# LANGUAGE TypeFamilies, EmptyDataDecls, TypeOperators, UndecidableInstances #-} {-# LANGUAGE TemplateHaskell, CPP #-} {-# OPTIONS_GHC -fcontext-stack=64 #-} import Language.Haskell.TH data Z data S n data Yes data No data Nil data x ::: xs type family a :<= b :: * type instance Z :<= Z = Yes type instance Z :<= S b = Yes type instance S n :<= Z = No type instance S a :<= S b = a :<= b type family a :== b :: * type instance Z :== Z = Yes type instance Z :== S b = No type instance S a :== Z = No type instance S a :== S b = a :== b type family a :- b :: * type instance a :- Z = a type instance S a :- S b = a :- b type Divisible a b = Divisible' (a :<= b) a b type family Divisible' t a b :: * type instance Divisible' Yes a b = a :== b type instance Divisible' No a b = Divisible (a :- b) b data Fizz data Buzz data FizzBuzz #define N 30 type family ToReadable x :: * type instance ToReadable Fizz = Fizz type instance ToReadable Buzz = Buzz type instance ToReadable FizzBuzz = FizzBuzz $( let cls = mkName "ToReadable" f i = let name = mkName ('N' : show i) nat = foldr appT (conT (mkName "Z")) $ replicate i (conT (mkName "S")) in [dataD (cxt []) name [] [] [], tySynInstD cls [nat] (conT name)] in sequence $ concatMap f [1 .. N] ) type ToFizzBuzz n = ToFizzBuzz' (Divisible n (S (S (S Z)))) (Divisible n (S (S (S (S (S Z)))))) n type family ToFizzBuzz' t3 t5 n :: * type instance ToFizzBuzz' No No n = ToReadable n type instance ToFizzBuzz' Yes No n = Fizz type instance ToFizzBuzz' No Yes n = Buzz type instance ToFizzBuzz' Yes Yes n = FizzBuzz type FizzBuzzList n = FizzBuzzList' n n type family FizzBuzzList' n i :: * type instance FizzBuzzList' n Z = Nil type instance FizzBuzzList' n (S i) = (ToFizzBuzz (n :- i)) ::: (FizzBuzzList' n i) class ShowType a where showType :: a main = let _ = showType :: FizzBuzzList $(foldr appT (conT (mkName "Z")) $ replicate N (conT (mkName "S"))) in return ()
出力例:
(snip) No instance for (ShowType (N1 ::: (N2 ::: (Fizz ::: (N4 ::: (Buzz ::: (Fizz ::: (N7 ::: (N8 ::: (Fizz ::: (Buzz ::: (N11 ::: (Fizz ::: (N13 ::: (N14 ::: (FizzBuzz ::: (N16 ::: (N17 ::: (Fizz ::: (N19 ::: (Buzz ::: (Fizz ::: (N22 ::: (N23 ::: (Fizz ::: (Buzz ::: (N26 ::: (Fizz ::: (N28 ::: (N29 ::: (FizzBuzz ::: Nil))))))))))))))))))))))))))))))) arising from a use of `showType' (snip)
*1:tySynInstD が無いらしい