content: module PreludeText {-(
      ReadS, ShowS,
      Read(readsPrec, readList),
      Show(showsPrec, showList),
      reads, shows, show, read, lex,
      showChar, showString, readParen, showParen )-} where
  
  -- The instances of Read and Show for
  -- Bool, Char, Maybe, Either, Ordering
  -- are done via "deriving" clauses in 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]
  
  -- Minimal complete definition:
  -- readsPrec
      readList         = readParen False (\r -> [pr | ("[",s)  <- lex r,
                                                      pr       <- 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
  
  -- Mimimal complete definition:
  -- show or 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 parses of
                           [x] -> x
                           []  -> error "Prelude.read: no parse"
                           _   -> error "Prelude.read: ambiguous parse"
    where parses = [x | (x,t) <- reads s, ("","") <- lex t]
  
  showChar         :: Char -> ShowS
  showChar         =  (:)
  
  showString       :: String -> ShowS
  showString       =  (++)
  
  showParen        :: Bool -> ShowS -> ShowS
  showParen b p    =  if b then showChar '(' . p . showChar ')' else p
  
  -- Basic printing combinators (nonstd, for use in derived Show instances):
  
  showParenArg :: Int -> ShowS -> ShowS
  showParenArg d = showParen (10<=d)
  
  showArgument x = showChar ' ' . showsPrec 10 x
  
  -- Basic parsing combinators (nonstd, for use in derived Read instances):
  
  readToken x t s = [(x,r)|(t',r)<-lex s,t'==t]
  
  readParenArg :: Int -> ReadS a -> ReadS a
  readParenArg d = readParen (10<=d)
  readArgument s = readsPrec 10 s
  
  rf `readAp` rx = \ s0 -> [(f x,s2) | (f,s1)<-rf s0,(x,s2)<-rx s1]
  
  readChoice rd1 rd2 s = rd1 s ++ rd2 s
  
  ---
  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    ]
  
  -- This lexer is not completely faithful to the Haskell lexical syntax.
  -- Current limitations:
  --    Qualified names are not handled properly
  --    Octal and hexidecimal numerics are not recognized as a single token
  --    Comments are not treated properly
  
  --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) =  [("\\&",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  = []    -- bad character
               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
  -- Converting to Integer avoids
  -- possible difficulty with minInt
  
  instance  Read Int  where
    readsPrec p r = [(fromInteger i, t) | (i,t) <- readsPrec p r]
  -- Reading at the Integer type avoids
  -- possible difficulty with 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         = readFloat
  
  instance  Show Double  where
      showsPrec p         = showFloat
  
  instance  Read Double  where
      readsPrec p         = 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
  
  -- Tuples
  
  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 ] )
  
  -- Other tuples have similar Read and Show instances
  