update READMEs
[haskell-report.git] / report / PreludeText.hs
1 module PreludeText (
2 ReadS, ShowS,
3 Read(readsPrec, readList),
4 Show(showsPrec, show, showList),
5 reads, shows, read, lex,
6 showChar, showString, readParen, showParen ) where
7
8 -- The instances of Read and Show for
9 -- Bool, Maybe, Either, Ordering
10 -- are done via "deriving" clauses in Prelude.hs
11
12 import Char(isSpace, isAlpha, isDigit, isAlphaNum,
13 showLitChar, readLitChar, lexLitChar)
14
15 import Numeric(showSigned, showInt, readSigned, readDec, showFloat,
16 readFloat, lexDigits)
17
18 type ReadS a = String -> [(a,String)]
19 type ShowS = String -> String
20
21 class Read a where
22 readsPrec :: Int -> ReadS a
23 readList :: ReadS [a]
24
25 -- Minimal complete definition:
26 -- readsPrec
27 readList = readParen False (\r -> [pr | ("[",s) <- lex r,
28 pr <- readl s])
29 where readl s = [([],t) | ("]",t) <- lex s] ++
30 [(x:xs,u) | (x,t) <- reads s,
31 (xs,u) <- readl' t]
32 readl' s = [([],t) | ("]",t) <- lex s] ++
33 [(x:xs,v) | (",",t) <- lex s,
34 (x,u) <- reads t,
35 (xs,v) <- readl' u]
36
37 class Show a where
38 showsPrec :: Int -> a -> ShowS
39 show :: a -> String
40 showList :: [a] -> ShowS
41
42 -- Mimimal complete definition:
43 -- show or showsPrec
44 showsPrec _ x s = show x ++ s
45
46 show x = showsPrec 0 x ""
47
48 showList [] = showString "[]"
49 showList (x:xs) = showChar '[' . shows x . showl xs
50 where showl [] = showChar ']'
51 showl (x:xs) = showChar ',' . shows x .
52 showl xs
53
54 reads :: (Read a) => ReadS a
55 reads = readsPrec 0
56
57 shows :: (Show a) => a -> ShowS
58 shows = showsPrec 0
59
60 read :: (Read a) => String -> a
61 read s = case [x | (x,t) <- reads s, ("","") <- lex t] of
62 [x] -> x
63 [] -> error "Prelude.read: no parse"
64 _ -> error "Prelude.read: ambiguous parse"
65
66 showChar :: Char -> ShowS
67 showChar = (:)
68
69 showString :: String -> ShowS
70 showString = (++)
71
72 showParen :: Bool -> ShowS -> ShowS
73 showParen b p = if b then showChar '(' . p . showChar ')' else p
74
75 readParen :: Bool -> ReadS a -> ReadS a
76 readParen b g = if b then mandatory else optional
77 where optional r = g r ++ mandatory r
78 mandatory r = [(x,u) | ("(",s) <- lex r,
79 (x,t) <- optional s,
80 (")",u) <- lex t ]
81
82 -- This lexer is not completely faithful to the Haskell lexical syntax.
83 -- Current limitations:
84 -- Qualified names are not handled properly
85 -- Octal and hexidecimal numerics are not recognized as a single token
86 -- Comments are not treated properly
87
88 lex :: ReadS String
89 lex "" = [("","")]
90 lex (c:s)
91 | isSpace c = lex (dropWhile isSpace s)
92 lex ('\'':s) = [('\'':ch++"'", t) | (ch,'\'':t) <- lexLitChar s,
93 ch /= "'" ]
94 lex ('"':s) = [('"':str, t) | (str,t) <- lexString s]
95 where
96 lexString ('"':s) = [("\"",s)]
97 lexString s = [(ch++str, u)
98 | (ch,t) <- lexStrItem s,
99 (str,u) <- lexString t ]
100
101 lexStrItem ('\\':'&':s) = [("\\&",s)]
102 lexStrItem ('\\':c:s) | isSpace c
103 = [("\\&",t) |
104 '\\':t <-
105 [dropWhile isSpace s]]
106 lexStrItem s = lexLitChar s
107
108 lex (c:s) | isSingle c = [([c],s)]
109 | isSym c = [(c:sym,t) | (sym,t) <- [span isSym s]]
110 | isAlpha c = [(c:nam,t) | (nam,t) <- [span isIdChar s]]
111 | isDigit c = [(c:ds++fe,t) | (ds,s) <- [span isDigit s],
112 (fe,t) <- lexFracExp s ]
113 | otherwise = [] -- bad character
114 where
115 isSingle c = c `elem` ",;()[]{}_`"
116 isSym c = c `elem` "!@#$%&*+./<=>?\\^|:-~"
117 isIdChar c = isAlphaNum c || c `elem` "_'"
118
119 lexFracExp ('.':c:cs) | isDigit c
120 = [('.':ds++e,u) | (ds,t) <- lexDigits (c:cs),
121 (e,u) <- lexExp t]
122 lexFracExp s = lexExp s
123
124 lexExp (e:s) | e `elem` "eE"
125 = [(e:c:ds,u) | (c:t) <- [s], c `elem` "+-",
126 (ds,u) <- lexDigits t] ++
127 [(e:ds,t) | (ds,t) <- lexDigits s]
128 lexExp s = [("",s)]
129
130 instance Show Int where
131 showsPrec n = showsPrec n . toInteger
132 -- Converting to Integer avoids
133 -- possible difficulty with minInt
134
135 instance Read Int where
136 readsPrec p r = [(fromInteger i, t) | (i,t) <- readsPrec p r]
137 -- Reading at the Integer type avoids
138 -- possible difficulty with minInt
139
140 instance Show Integer where
141 showsPrec = showSigned showInt
142
143 instance Read Integer where
144 readsPrec p = readSigned readDec
145
146 instance Show Float where
147 showsPrec p = showFloat
148
149 instance Read Float where
150 readsPrec p = readSigned readFloat
151
152 instance Show Double where
153 showsPrec p = showFloat
154
155 instance Read Double where
156 readsPrec p = readSigned readFloat
157
158 instance Show () where
159 showsPrec p () = showString "()"
160
161 instance Read () where
162 readsPrec p = readParen False
163 (\r -> [((),t) | ("(",s) <- lex r,
164 (")",t) <- lex s ] )
165 instance Show Char where
166 showsPrec p '\'' = showString "'\\''"
167 showsPrec p c = showChar '\'' . showLitChar c . showChar '\''
168
169 showList cs = showChar '"' . showl cs
170 where showl "" = showChar '"'
171 showl ('"':cs) = showString "\\\"" . showl cs
172 showl (c:cs) = showLitChar c . showl cs
173
174 instance Read Char where
175 readsPrec p = readParen False
176 (\r -> [(c,t) | ('\'':s,t)<- lex r,
177 (c,"\'") <- readLitChar s])
178
179 readList = readParen False (\r -> [(l,t) | ('"':s, t) <- lex r,
180 (l,_) <- readl s ])
181 where readl ('"':s) = [("",s)]
182 readl ('\\':'&':s) = readl s
183 readl s = [(c:cs,u) | (c ,t) <- readLitChar s,
184 (cs,u) <- readl t ]
185
186 instance (Show a) => Show [a] where
187 showsPrec p = showList
188
189 instance (Read a) => Read [a] where
190 readsPrec p = readList
191
192 -- Tuples
193
194 instance (Show a, Show b) => Show (a,b) where
195 showsPrec p (x,y) = showChar '(' . shows x . showChar ',' .
196 shows y . showChar ')'
197
198 instance (Read a, Read b) => Read (a,b) where
199 readsPrec p = readParen False
200 (\r -> [((x,y), w) | ("(",s) <- lex r,
201 (x,t) <- reads s,
202 (",",u) <- lex t,
203 (y,v) <- reads u,
204 (")",w) <- lex v ] )
205
206 -- Other tuples have similar Read and Show instances
207
208
209