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