| Россия, Петерубрг, СПБ-ГПУ, 1998 |
Инспектор
Вы можете этот курс.
Опубликован: 19.09.2008 | Уровень: специалист | Доступ: платный
Лекция 9:
Стандартное начало (Prelude)
8.2. Prelude PreludeText
module PreludeText (
ReadS, ShowS,
Read(readsPrec, readList),
Show(showsPrec, show, showList),
reads, shows, read, lex,
showChar, showString, readParen, showParen ) where- Экземпляры классов Read и Show для - Bool, Maybe, Either, Ordering - созданы посредством инструкций "deriving" в Prelude.hs
import Char(isSpace, isAlpha, isDigit, isAlphaNum,
showLitChar, readLitChar, lexLitChar)
import Numeric(showSigned, showInt, readSigned, readDec, showFloat,
readFloat, lexDigits)
type ReadS a = String -> [(a,String)]
type ShowS = String -> String
class Read a where
readsPrec :: Int -> ReadS a
readList :: ReadS [a]- Минимальное полное определение: - readsPrec
readList = readParen False (\r -> [pr | ("[",s) <- lex r,
pr 7gt;- readl s])
where readl s = [([],t) | ("]",t) >- lex s] ++
[(x:xs,u) | (x,t) >- reads s,
(xs,u) >- readl' t]
readl' s = [([],t) | ("]",t) >- lex s] ++
[(x:xs,v) | (",",t) >- lex s,
(x,u) >- reads t,
(xs,v) >- readl' u]
class Show a where
showsPrec :: Int -> a -> ShowS
show :: a -> String
showList :: [a] -> ShowS- Минимальное полное определение: - show или showsPrec
showsPrec _ x s = show x ++ s
show x = showsPrec 0 x ""
showList [] = showString "[]"
showList (x:xs) = showChar '[' . shows x . showl xs
where showl [] = showChar ']'
showl (x:xs) = showChar ',' . shows x .
showl xs
reads :: (Read a) => ReadS a
reads = readsPrec 0
shows :: (Show a) => a -> ShowS
shows = showsPrec 0
read :: (Read a) => String -> a
read s = case [x | (x,t) <- reads s, ("","") <- lex t] of
[x] -> x
[] -> error "Prelude.read: нет разбора"
_ -> error "Prelude.read: неоднозначный разбор"
showChar :: Char -> ShowS
showChar = (:)
showString :: String -> ShowS
showString = (++)
showParen :: Bool -> ShowS -> ShowS
showParen b p = if b then showChar '(' . p . showChar ')' else p
readParen :: Bool -> ReadS a -> ReadS a
readParen b g = if b then mandatory else optional
where optional r = g r ++ mandatory r
mandatory r = [(x,u) | ("(",s) <- lex r,
(x,t) <- optional s,
(")",u) <- lex t ]- Этот лексический анализатор не полностью соответствует лексическому синтаксису Haskell.
- Текущие ограничения:
- - Квалифицированные имена не управляются должным образом
- - Восьмиричные и шестнадцатиричные цифры не распознаются как отдельный токен
- - Комментарии не обрабатываются должным образом
lex :: ReadS String
lex "" = [("","")]
lex (c:s)
| isSpace c = lex (dropWhile isSpace s)
lex ('\'':s) = [('\'':ch++"'", t) | (ch,'\'':t) <- lexLitChar s,
ch /= "'" ]
lex ('"':s) = [('"':str, t) | (str,t) <- lexString s]
where
lexString ('"':s) = [("\"",s)]
lexString s = [(ch++str, u)
| (ch,t) <- lexStrItem s,
(str,u) <- lexString t ]
lexStrItem ('\\':'&':s) = [("\\amp;&",s)]
lexStrItem ('\\':c:s) | isSpace c
= [("\\&",t) |
'\\':t <-
[dropWhile isSpace s]]
lexStrItem s = lexLitChar s
lex (c:s) | isSingle c = [([c],s)]
| isSym c = [(c:sym,t) | (sym,t) <- [span isSym s]]
| isAlpha c = [(c:nam,t) | (nam,t) <- [span isIdChar s]]
| isDigit c = [(c:ds++fe,t) | (ds,s) <- [span isDigit s],
(fe,t) <- lexFracExp s ]
| otherwise = [] - плохой символ
where
isSingle c = c `elem` ",;()[]{}_`"
isSym c = c `elem` "!@#$%&*+./<=>?\\^|:-~"
isIdChar c = isAlphaNum c || c `elem` "_'"
lexFracExp ('.':c:cs) | isDigit c
= [('.':ds++e,u) | (ds,t) <- lexDigits (c:cs),
(e,u) <- lexExp t]
lexFracExp s = lexExp s
lexExp (e:s) | e `elem` "eE"
= [(e:c:ds,u) | (c:t) <- [s], c `elem` "+-",
(ds,u) <- lexDigits t] ++
[(e:ds,t) | (ds,t) <- lexDigits s]
lexExp s = [("",s)]
instance Show Int where
showsPrec n = showsPrec n . toInteger- Преобразование к Integer позволяет избежать - возможного противоречия с minInt
instance Read Int where readsPrec p r = [(fromInteger i, t) | (i,t) <- readsPrec p r]
- Считывание в тип Integer позволяет избежать - возможного противоречия с minInt
instance Show Integer where
showsPrec = showSigned showInt
instance Read Integer where
readsPrec p = readSigned readDec
instance Show Float where
showsPrec p = showFloat
instance Read Float where
readsPrec p = readSigned readFloat
instance Show Double where
showsPrec p = showFloat
instance Read Double where
readsPrec p = readSigned readFloat
instance Show () where
showsPrec p () = showString "()"
instance Read () where
readsPrec p = readParen False
(\r -> [((),t) | ("(",s) <- lex r,
(")",t) <- lex s ] )
instance Show Char where
showsPrec p '\'' = showString "'\\''"
showsPrec p c = showChar '\'' . showLitChar c . showChar '\''
showList cs = showChar '"' . showl cs
where showl "" = showChar '"'
showl ('"':cs) = showString "\\\"" . showl cs
showl (c:cs) = showLitChar c . showl cs
instance Read Char where
readsPrec p = readParen False
(\r -> [(c,t) | ('\'':s,t)<- lex r,
(c,"\'") <- readLitChar s])
readList = readParen False (\r -> [(l,t) | ('"':s, t) <- lex r,
(l,_) <- readl s ])
where readl ('"':s) = [("",s)]
readl ('\\':'&':s) = readl s
readl s = [(c:cs,u) | (c ,t) <- readLitChar s,
(cs,u) <- readl t ]
instance (Show a) => Show [a] where
showsPrec p = showList
instance (Read a) => Read [a] where
readsPrec p = readList- Кортежи
instance (Show a, Show b) => Show (a,b) where
showsPrec p (x,y) = showChar '(' . shows x . showChar ',' .
shows y . showChar ')'
instance (Read a, Read b) => Read (a,b) where
readsPrec p = readParen False
(\r -> [((x,y), w) | ("(",s) <- lex r,
(x,t) <- reads s,
(",",u) <- lex t,
(y,v) <- reads u,
(")",w) <- lex v ] )- Другие кортежи имеют сходные экземпляры классов Read и Show
