Haskellでprintf書くのってどうやるの?

っていう、可変長引数にも繋がるお話。

GHCのprintfのコードが長過ぎて嫌だなーという女子大生の方向けに、小さく抜き出したものが以下のコード

data UPrintf = UString String | UInt Int

my_printf :: (PrintfType r) => String -> r
my_printf fmts = spr fmts []

class PrintfType t where
    spr :: String -> [UPrintf] -> t

class PrintfArg a where
    toUPrintf :: a -> UPrintf

instance PrintfType String where
    spr fmts args = uprintf fmts (reverse args)

instance PrintfType (IO a) where
    spr fmts args = do putStrLn (uprintf fmts (reverse args))
                       return undefined

instance (PrintfArg a, PrintfType r) => PrintfType (a -> r) where
    spr fmts args = \a -> spr fmts (toUPrintf a : args)

instance PrintfArg Int where
    toUPrintf = UInt

instance PrintfArg String where
    toUPrintf = UString

uprintf :: String -> [UPrintf] -> String
uprintf "" []                          = ""
uprintf "" (_:_)                       = fmterr
uprintf ('%':_) []                     = argerr
uprintf ('%':'d':cs) ((UInt i):res)    = (show i) ++ uprintf cs res
uprintf ('%':'s':cs) ((UString s):res) = s ++ (uprintf cs res)
uprintf (c:cs) us                      = c:uprintf cs us

perror :: String -> a
perror s = error ("print: "++s)
fmterr = perror "formatting string ended prematurely"
argerr = perror "argument list ended prematurely"

usage:
my_printf "hoge %d %s" (1::Int) "bar"

このprintf(GHCのprintfとほぼ同じものですが)が悪いお話は
http://page.freett.com/shelarcy/log/2008/diary_04.html#continuation_fest_2008
ここに書かれています。

つまり、"コンパイル時に静的に型安全であるかどうかを調べる事が出来ず、実行時にerrorが吐かれる"という事です。
例えば

main = my_printf "hoge %d %d" "bar" "fuga"

/Users/ranha/Cayenne/Paper/src% ghc -fglasgow-exts mock_printf.hs
a.out: print: formatting string ended prematurely

とこんな具合。

じゃあCayenneだとどうなりますか

っていう話。
Cayenneでのprintfを再載

-- printf.cy
module sample$print =
#include Prelude
struct
concrete
PrintfType :: String -> #
PrintfType (Nil)        = String
PrintfType ('%':'d':cs) = Integer-> PrintfType cs
PrintfType ('%':'s':cs) = String -> PrintfType cs
PrintfType (c:cs)       =           PrintfType cs

my_printf :: (fmt :: String) -> PrintfType fmt
my_printf fmt = pr fmt ""

private
pr :: (fmt :: String) -> String -> PrintfType fmt
pr (Nil)        res = res
pr ('%':'d':cs) res = \ i -> pr cs (res ++ show i)
pr ('%':'s':cs) res = \ s -> pr cs (res ++ s)
pr (c:cs)       res = pr cs (res ++ c:Nil)

--use.cy
module sample$use = 
#include Prelude
open sample$print use * in

do Monad_IO
  putStrLn (my_printf "Hello,World!!")
  putStrLn (my_printf "%d %d %s Hoge" 1 2 "Foo")
  putStrLn (my_printf "%d %d" "Foo" "Bar")

/Users/ranha/Cayenne/misc% cayenne print.cy 
/Users/ranha/Cayenne/misc% cayenne use.cy
cayenne: Compilation errors:
"use.cy", line 8, column 30, Type error: chkT
Expression
"Foo"
  has type
data Nil |
     (:)
       System$CharType.Char
       (let type List a = data Nil | (:) a (List a);
	in  List System$CharType.Char)
  but should have type
System$Integer.Integer

素晴らしい！！！

#やってる事が違うんですけどもね