lib/mlton/basic/instream0.sml

   1 (* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
   2  *    Jagannathan, and Stephen Weeks.
   3  *
   4  * MLton is released under a BSD-style license.
   5  * See the file MLton-LICENSE for details.
   6  *)
   7
   8 structure Instream0 =
   9 struct
  10
  11 structure String = String0
  12 structure Char = String.Char
  13 structure I = Pervasive.TextIO
  14 open I
  15
  16 type t = I.instream
  17
  18 val standard = stdIn
  19 val close = closeIn
  20 val inputChar = input1
  21 val peekChar = lookahead
  22 val endOf = endOfStream
  23
  24 fun foldChars (ins, a, f) =
  25    let
  26       fun loop a =
  27          case inputLine ins of
  28             NONE => a
  29           | SOME l => loop (String.fold (l, a, f))
  30    in
  31       loop a
  32    end
  33
  34 fun foldLines (ins, ac, f) =
  35    let
  36       fun loop ac =
  37          case inputLine ins of
  38             NONE => ac
  39           | SOME l => loop (f (l, ac))
  40    in loop ac
  41    end
  42
  43 fun foreachLine (ins, f) = foldLines (ins, (), f o #1)
  44
  45 fun inputTo (i: t, p: char -> bool): string =
  46    let
  47       val maxListLength = 1000
  48       fun finish chars = String.rev (String.implode chars)
  49       fun loop (n, chars, strings) =
  50          case peekChar i of
  51             NONE => (chars, strings)
  52           | SOME c =>
  53                if p c
  54                   then (chars, strings)
  55                else
  56                   let
  57                      val chars = c :: chars
  58                      val _ = inputChar i
  59                   in
  60                      if n > 0
  61                         then loop (n - 1, chars, strings)
  62                      else loop (maxListLength,
  63                                 [],
  64                                 finish chars :: strings)
  65                   end
  66       val (chars, strings) = loop (maxListLength, [], [])
  67    in
  68       concat (rev (finish chars :: strings))
  69    end
  70
  71 fun sameContents (in1, in2) =
  72    let
  73       fun loop () =
  74          case (input1 in1, input1 in2) of
  75             (NONE, NONE) => true
  76           | (SOME c1, SOME c2) => Char.equals (c1, c2) andalso loop ()
  77           | _ => false
  78    in loop ()
  79    end
  80
  81 fun inputToSpace i = inputTo (i, Char.isSpace)
  82 fun inputToChar (i, c) = inputTo (i, fn c' => Char.equals (c, c'))
  83 fun ignoreSpaces i = ignore (inputTo (i,not o Char.isSpace))
  84
  85 fun inputNothing _ = ()
  86
  87 fun layout _ = Layout.str "<instream>"
  88
  89 (*val set = MLton.TextIO.setIn *)
  90
  91 end
  92
  93 structure In0 = Instream0