X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Text%2FPrintf.hs;h=7d4611eadef37eae08e9af106c2d11450e5e84c3;hb=3a7e8de77666fab3f6d2a7fc5c813cbca77ad57d;hp=bfd1ed658ab2f484e84266124220402702ffb310;hpb=c3aaf44ddd7e1c725e63f606ea5ddfe6a8d2bb89;p=ghc-base.git

diff --git a/Text/Printf.hs b/Text/Printf.hs
index bfd1ed6..7d4611e 100644
--- a/Text/Printf.hs
+++ b/Text/Printf.hs
@@ -1,7 +1,9 @@
+{-# LANGUAGE CPP #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Text.Printf
--- Copyright   :  (c) Lennart Augustsson, 2004
+-- Copyright   :  (c) Lennart Augustsson, 2004-2008
 -- License     :  BSD-style (see the file libraries/base/LICENSE)
 -- 
 -- Maintainer  :  lennart@augustsson.net
@@ -12,6 +14,8 @@
 --
 -----------------------------------------------------------------------------
 
+{-# Language CPP #-}
+
 module Text.Printf(
    printf, hPrintf,
    PrintfType, HPrintfType, PrintfArg, IsChar
@@ -215,39 +219,42 @@ fmt cs us =
 	    u:us'' ->
 		(case c of
 		'c' -> adjust  ("", [toEnum (toint u)])
-		'd' -> adjust' (fmti u)
-		'i' -> adjust' (fmti u)
-		'x' -> adjust  ("", fmtu 16 u)
-		'X' -> adjust  ("", map toUpper $ fmtu 16 u)
-		'o' -> adjust  ("", fmtu 8  u)
-		'u' -> adjust  ("", fmtu 10 u)
+		'd' -> adjust' (fmti prec u)
+		'i' -> adjust' (fmti prec u)
+		'x' -> adjust  ("", fmtu 16 prec u)
+		'X' -> adjust  ("", map toUpper $ fmtu 16 prec u)
+		'o' -> adjust  ("", fmtu 8  prec u)
+		'u' -> adjust  ("", fmtu 10 prec u)
 		'e' -> adjust' (dfmt' c prec u)
 		'E' -> adjust' (dfmt' c prec u)
 		'f' -> adjust' (dfmt' c prec u)
 		'g' -> adjust' (dfmt' c prec u)
 		'G' -> adjust' (dfmt' c prec u)
-		's' -> adjust  ("", tostr u)
+		's' -> adjust  ("", tostr prec u)
 		_   -> perror ("bad formatting char " ++ [c])
 		 ) ++ uprintf cs'' us''
 
-fmti :: UPrintf -> (String, String)
-fmti (UInteger _ i) = if i < 0 then ("-", show (-i)) else ("", show i)
-fmti (UChar c)      = fmti (uInteger (fromEnum c))
-fmti _		    = baderr
+fmti :: Int -> UPrintf -> (String, String)
+fmti prec (UInteger _ i) = if i < 0 then ("-", integral_prec prec (show (-i))) else ("", integral_prec prec (show i))
+fmti _ (UChar c)         = fmti 0 (uInteger (fromEnum c))
+fmti _ _                 = baderr
+
+fmtu :: Integer -> Int -> UPrintf -> String
+fmtu b prec (UInteger l i) = integral_prec prec (itosb b (if i < 0 then -2*l + i else i))
+fmtu b _    (UChar c)      = itosb b (toInteger (fromEnum c))
+fmtu _ _ _                 = baderr
 
-fmtu :: Integer -> UPrintf -> String
-fmtu b (UInteger l i) = itosb b (if i < 0 then -2*l + i else i)
-fmtu b (UChar c)      = itosb b (toInteger (fromEnum c))
-fmtu _ _              = baderr
+integral_prec :: Int -> String -> String
+integral_prec prec integral = (replicate (prec - (length integral)) '0') ++ integral
 
 toint :: UPrintf -> Int
 toint (UInteger _ i) = fromInteger i
 toint (UChar c)      = fromEnum c
 toint _		     = baderr
 
-tostr :: UPrintf -> String
-tostr (UString s) = s
-tostr _		  = baderr
+tostr :: Int -> UPrintf -> String
+tostr n (UString s) = if n >= 0 then take n s else s
+tostr _ _		  = baderr
 
 itosb :: Integer -> Integer -> String
 itosb b n = 
@@ -265,28 +272,37 @@ getSpecs :: Bool -> Bool -> Bool -> String -> [UPrintf] -> (Int, Int, Bool, Bool
 getSpecs _ z s ('-':cs) us = getSpecs True z s cs us
 getSpecs l z _ ('+':cs) us = getSpecs l z True cs us
 getSpecs l _ s ('0':cs) us = getSpecs l True s cs us
-getSpecs l z s ('*':cs) us = 
-        case us of
-        [] -> argerr
-        nu : us' ->
-	    let n = toint nu
-		(p, cs'', us'') =
+getSpecs l z s ('*':cs) us =
+	let (us', n) = getStar us
+	    ((p, cs''), us'') =
 		    case cs of
-                    '.':'*':r -> case us' of { [] -> argerr; pu:us''' -> (toint pu, r, us''') }
-		    '.':r     -> let (n', cs') = stoi 0 r in (n', cs', us')
-		    _         -> (-1, cs, us')
-	    in  (n, p, l, z, s, cs'', us'')
+                    '.':'*':r -> let (us''', p') = getStar us'
+		    	      	 in  ((p', r), us''')
+		    '.':r     -> (stoi 0 r, us')
+		    _         -> ((-1, cs), us')
+	in  (n, p, l, z, s, cs'', us'')
 getSpecs l z s ('.':cs) us =
-	let (p, cs') = stoi 0 cs
-	in  (0, p, l, z, s, cs', us)
+	let ((p, cs'), us') = 
+	        case cs of
+		'*':cs'' -> let (us'', p') = getStar us in ((p', cs''), us'')
+                _ ->        (stoi 0 cs, us)
+	in  (0, p, l, z, s, cs', us')
 getSpecs l z s cs@(c:_) us | isDigit c =
 	let (n, cs') = stoi 0 cs
-	    (p, cs'') = case cs' of
-			'.':r -> stoi 0 r
-			_     -> (-1, cs')
-	in  (n, p, l, z, s, cs'', us)
+	    ((p, cs''), us') = case cs' of
+	    	 	       '.':'*':r -> let (us'', p') = getStar us in ((p', r), us'')
+		               '.':r -> (stoi 0 r, us)
+			       _     -> ((-1, cs'), us)
+	in  (n, p, l, z, s, cs'', us')
 getSpecs l z s cs       us = (0, -1, l, z, s, cs, us)
 
+getStar :: [UPrintf] -> ([UPrintf], Int)
+getStar us =
+    case us of
+    [] -> argerr
+    nu : us' -> (us', toint nu)
+
+
 dfmt' :: Char -> Int -> UPrintf -> (String, String)
 dfmt' c p (UDouble d) = dfmt c p d
 dfmt' c p (UFloat f)  = dfmt c p f