1structure QFRead :> QFRead =
2struct
3
4type reader =
5     {read : unit -> char option, reset : unit -> unit, eof : unit -> bool}
6fun die s = (TextIO.output(TextIO.stdErr, s ^ "\n");
7             OS.Process.exit OS.Process.failure)
8fun exndie e = die ("Exception raised " ^ General.exnMessage e)
9
10fun exhaust_lexer (read, close, _) =
11  let
12    fun recurse acc =
13      case read () of
14          "" => (close(); String.concat (List.rev acc))
15        | s => recurse (s::acc)
16  in
17    recurse []
18  end
19
20fun reset st = fn () => QuoteFilter.UserDeclarations.resetstate st
21
22fun mkstate b = {inscriptp = b, quotefixp = false}
23
24fun file_to_lexer fname =
25  let
26
27    val instrm = TextIO.openIn fname handle e => exndie e
28    val isscript = String.isSuffix "Script.sml" fname
29    val qstate = QuoteFilter.UserDeclarations.newstate (mkstate isscript)
30    val read = QuoteFilter.makeLexer (fn n => TextIO.input instrm) qstate
31  in
32    (#2 o read, (fn () => TextIO.closeIn instrm), reset qstate)
33  end
34
35fun string_to_lexer isscriptp s =
36  let
37    val qstate = QuoteFilter.UserDeclarations.newstate (mkstate isscriptp)
38    val sr = ref s
39    fun str_read _ = (!sr before sr := "")
40    val read = QuoteFilter.makeLexer str_read qstate
41  in
42    (#2 o read, (fn () => ()), reset qstate)
43  end
44
45fun stream_to_lexer isscriptp strm =
46  let
47    val qstate = QuoteFilter.UserDeclarations.newstate (mkstate isscriptp)
48    val read = QuoteFilter.makeLexer (fn n => TextIO.input strm) qstate
49  in
50    (#2 o read, (fn () => ()), reset qstate)
51  end
52
53fun inputFile fname = exhaust_lexer (file_to_lexer fname)
54fun fromString b s = exhaust_lexer (string_to_lexer b s)
55
56fun mkReaderEOF (read, close, reset) = let
57  val i = ref 0
58  val s = ref ""
59  val sz = ref 0
60  val eofp = ref false
61  fun pull () = (s := read(); sz := size (!s); i := 0;
62                 if !sz = 0 then (eofp := true; close()) else ())
63  fun doit () =
64    if !eofp then NONE
65    else if !i < !sz then SOME (String.sub(!s,!i)) before i := !i + 1
66    else (pull(); doit())
67  fun eof () = !eofp
68in
69  {read = doit, eof = eof, reset = reset}
70end
71
72fun fileToReader fname = mkReaderEOF (file_to_lexer fname)
73fun stringToReader b s = mkReaderEOF (string_to_lexer b s)
74fun streamToReader b strm = mkReaderEOF (stream_to_lexer b strm)
75
76end
77