\begin{code}
module Text.Printf.TH (printf) where
import Language.Haskell.TH
import Text.Printf.TH.Parser (parse)
import Text.Printf.TH.Types
import Text.Printf.TH.Simplify (simplify)
printf :: String -> ExpQ
printf s = do
let (formats, max_x_var) = parse s
x_vars = (map (varP . mkName . xvar) [1..max_x_var])
dec_n0 = valD (varP $ mkName $ nvar 0) (normalB [| 0 |]) []
e <- lamE x_vars (combine [dec_n0] [| showString "" |] 1 formats)
return $ simplify e
combine :: [DecQ]
-> ExpQ
-> ArgNum
-> [Format]
-> ExpQ
combine decls building_exp y_num []
= letE decls (tupE (e:(map (varE . mkName . nvar) [1..y_num1])))
where e = appE (foldr appE building_exp (map (varE . mkName . yvar) [1..y_num1]))
[| "" |]
combine decls building_exp y_num (CharCount:fs)
= combine (decl_y:decl_n:decls) [| showString "" |] (y_num + 1) fs
where decl_y = valD (varP ( mkName $ yvar y_num)) (normalB building_exp') []
decl_n = valD (varP ( mkName $ nvar y_num)) (normalB length_exp) []
building_exp' = [| ($building_exp .) |]
length_exp = [| $( varE ( mkName $ nvar (y_num 1)))
+ length ($(varE ( mkName $ yvar y_num)) (showString "") "") |]
combine decls building_exp y_num (Literal s:fs)
= combine decls [| $building_exp . showString s |] y_num fs
combine decls building_exp y_num (Conversion e:fs)
= combine decls [| $building_exp . showString $e |] y_num fs
\end{code}