src/Pure/General/source.ML
author wenzelm
Fri Nov 25 18:37:14 2011 +0100 (2011-11-25 ago)
changeset 45633 2cb7e34f6096
parent 40627 becf5d5187cc
child 54387 890e983cb07b
permissions -rw-r--r--
retain stderr and include it in syslog, which is buffered and thus increases the chance that users see remains from crashes etc.;
wenzelm@6118
     1
(*  Title:      Pure/General/source.ML
wenzelm@6116
     2
    Author:     Markus Wenzel, TU Muenchen
wenzelm@6116
     3
wenzelm@8806
     4
Coalgebraic data sources -- efficient purely functional input streams.
wenzelm@6116
     5
*)
wenzelm@6116
     6
wenzelm@6116
     7
signature SOURCE =
wenzelm@6116
     8
sig
wenzelm@6116
     9
  type ('a, 'b) source
wenzelm@6681
    10
  val default_prompt: string
wenzelm@6116
    11
  val set_prompt: string -> ('a, 'b) source -> ('a, 'b) source
wenzelm@6116
    12
  val get: ('a, 'b) source -> 'a list * ('a, 'b) source
wenzelm@6116
    13
  val unget: 'a list * ('a, 'b) source -> ('a, 'b) source
wenzelm@6116
    14
  val get_single: ('a, 'b) source -> ('a * ('a, 'b) source) option
wenzelm@6116
    15
  val exhaust: ('a, 'b) source -> 'a list
wenzelm@19485
    16
  val map_filter: ('a -> 'b option) -> ('a, 'c) source -> ('b, ('a, 'c) source) source
wenzelm@6116
    17
  val filter: ('a -> bool) -> ('a, 'b) source -> ('a, ('a, 'b) source) source
wenzelm@6116
    18
  val of_list: 'a list -> ('a, 'a list) source
wenzelm@37903
    19
  val exhausted: ('a, 'b) source -> ('a, 'a list) source
wenzelm@6116
    20
  val of_string: string -> (string, string list) source
wenzelm@37903
    21
  val of_string_limited: int -> string -> (string, substring) source
wenzelm@38253
    22
  val tty: TextIO.instream -> (string, unit) source
wenzelm@27732
    23
  val source': 'a -> 'b Scan.stopper -> ('a * 'b list -> 'c list * ('a * 'b list)) ->
wenzelm@23682
    24
    (bool * (string -> 'a * 'b list -> 'c list * ('a * 'b list))) option ->
wenzelm@6116
    25
    ('b, 'e) source -> ('c, 'a * ('b, 'e) source) source
wenzelm@27732
    26
  val source: 'a Scan.stopper -> ('a list -> 'b list * 'a list) ->
wenzelm@23682
    27
    (bool * (string -> 'a list -> 'b list * 'a list)) option ->
wenzelm@6116
    28
    ('a, 'd) source -> ('b, ('a, 'd) source) source
wenzelm@6116
    29
end;
wenzelm@6116
    30
wenzelm@6116
    31
structure Source: SOURCE =
wenzelm@6116
    32
struct
wenzelm@6116
    33
wenzelm@6116
    34
wenzelm@6116
    35
(** datatype source **)
wenzelm@6116
    36
wenzelm@6116
    37
datatype ('a, 'b) source =
wenzelm@6116
    38
  Source of
wenzelm@6116
    39
   {buffer: 'a list,
wenzelm@6116
    40
    info: 'b,
wenzelm@6116
    41
    prompt: string,
wenzelm@6116
    42
    drain: string -> 'b -> 'a list * 'b};
wenzelm@6116
    43
wenzelm@6116
    44
fun make_source buffer info prompt drain =
wenzelm@6116
    45
  Source {buffer = buffer, info = info, prompt = prompt, drain = drain};
wenzelm@6116
    46
wenzelm@6116
    47
wenzelm@6116
    48
(* prompt *)
wenzelm@6116
    49
wenzelm@6116
    50
val default_prompt = "> ";
wenzelm@6116
    51
wenzelm@6116
    52
fun set_prompt prompt (Source {buffer, info, prompt = _, drain}) =
wenzelm@6116
    53
  make_source buffer info prompt drain;
wenzelm@6116
    54
wenzelm@6116
    55
wenzelm@6116
    56
(* get / unget *)
wenzelm@6116
    57
wenzelm@6116
    58
fun get (Source {buffer = [], info, prompt, drain}) =
wenzelm@6116
    59
      let val (xs, info') = drain prompt info
wenzelm@6116
    60
      in (xs, make_source [] info' prompt drain) end
wenzelm@6116
    61
  | get (Source {buffer, info, prompt, drain}) =
wenzelm@6116
    62
      (buffer, make_source [] info prompt drain);
wenzelm@6116
    63
wenzelm@6116
    64
fun unget (xs, Source {buffer, info, prompt, drain}) =
wenzelm@6116
    65
  make_source (xs @ buffer) info prompt drain;
wenzelm@6116
    66
wenzelm@6116
    67
wenzelm@6116
    68
(* variations on get *)
wenzelm@6116
    69
wenzelm@6116
    70
fun get_prompt prompt src = get (set_prompt prompt src);
wenzelm@6116
    71
wenzelm@6116
    72
fun get_single src =
wenzelm@6116
    73
  (case get src of
skalberg@15531
    74
    ([], _) => NONE
skalberg@15531
    75
  | (x :: xs, src') => SOME (x, unget (xs, src')));
wenzelm@6116
    76
wenzelm@6116
    77
fun exhaust src =
wenzelm@6116
    78
  (case get src of
wenzelm@6116
    79
    ([], _) => []
wenzelm@6116
    80
  | (xs, src') => xs @ exhaust src');
wenzelm@6116
    81
wenzelm@6116
    82
wenzelm@6116
    83
(* (map)filter *)
wenzelm@6116
    84
wenzelm@19485
    85
fun drain_map_filter f prompt src =
wenzelm@6116
    86
  let
wenzelm@6116
    87
    val (xs, src') = get_prompt prompt src;
wenzelm@19485
    88
    val xs' = map_filter f xs;
wenzelm@6116
    89
  in
wenzelm@6116
    90
    if null xs orelse not (null xs') then (xs', src')
wenzelm@19485
    91
    else drain_map_filter f prompt src'
wenzelm@6116
    92
  end;
wenzelm@6116
    93
wenzelm@19485
    94
fun map_filter f src = make_source [] src default_prompt (drain_map_filter f);
wenzelm@19485
    95
fun filter pred = map_filter (fn x => if pred x then SOME x else NONE);
wenzelm@6116
    96
wenzelm@6116
    97
wenzelm@6116
    98
wenzelm@6116
    99
(** build sources **)
wenzelm@6116
   100
wenzelm@6116
   101
(* list source *)
wenzelm@6116
   102
wenzelm@14727
   103
fun of_list xs = make_source [] xs default_prompt (fn _ => fn xs => (xs, []));
wenzelm@37903
   104
wenzelm@37903
   105
fun exhausted src = of_list (exhaust src);
wenzelm@37903
   106
wenzelm@37903
   107
wenzelm@37903
   108
(* string source *)
wenzelm@6181
   109
wenzelm@40627
   110
val of_string = of_list o raw_explode;
wenzelm@23875
   111
wenzelm@37903
   112
fun of_string_limited limit str =
wenzelm@37903
   113
  make_source [] (Substring.full str) default_prompt
wenzelm@37903
   114
    (fn _ => fn s =>
wenzelm@37903
   115
      let
wenzelm@37903
   116
        val (s1, s2) = Substring.splitAt (s, Int.min (Substring.size s, limit));
wenzelm@37903
   117
        val cs = map String.str (Substring.explode s1);
wenzelm@37903
   118
      in (cs, s2) end);
wenzelm@9123
   119
wenzelm@6116
   120
wenzelm@6116
   121
(* stream source *)
wenzelm@6116
   122
wenzelm@24232
   123
fun slurp_input instream =
wenzelm@20737
   124
  let
wenzelm@20737
   125
    fun slurp () =
wenzelm@20737
   126
      (case TextIO.canInput (instream, 1) handle IO.Io _ => NONE of
wenzelm@20737
   127
        NONE => []
wenzelm@20737
   128
      | SOME 0 => []
wenzelm@20737
   129
      | SOME _ => TextIO.input instream :: slurp ());
wenzelm@40627
   130
  in maps raw_explode (slurp ()) end;
wenzelm@20737
   131
wenzelm@38253
   132
fun tty in_stream = make_source [] () default_prompt (fn prompt => fn () =>
wenzelm@38253
   133
  let val input = slurp_input in_stream in
wenzelm@20737
   134
    if exists (fn c => c = "\n") input then (input, ())
wenzelm@20737
   135
    else
wenzelm@38253
   136
      (case (Output.prompt prompt; TextIO.inputLine in_stream) of
wenzelm@40627
   137
        SOME line => (input @ raw_explode line, ())
wenzelm@25575
   138
      | NONE => (input, ()))
wenzelm@25846
   139
  end);
wenzelm@6116
   140
wenzelm@6116
   141
wenzelm@6116
   142
wenzelm@23700
   143
(** cascade sources **)
wenzelm@6116
   144
wenzelm@6116
   145
(* state-based *)
wenzelm@6116
   146
wenzelm@23700
   147
fun drain_source' stopper scan opt_recover prompt (state, src) =
wenzelm@23700
   148
  let
wenzelm@23700
   149
    val drain = Scan.drain prompt get_prompt stopper;
wenzelm@23700
   150
    val (xs, s) = get_prompt prompt src;
wenzelm@23700
   151
    val inp = ((state, xs), s);
wenzelm@23700
   152
    val ((ys, (state', xs')), src') =
wenzelm@23700
   153
      if null xs then (([], (state, [])), s)
wenzelm@23700
   154
      else
wenzelm@23700
   155
        (case opt_recover of
wenzelm@23700
   156
          NONE => drain (Scan.error scan) inp
wenzelm@23700
   157
        | SOME (interactive, recover) =>
wenzelm@23700
   158
            (drain (Scan.catch scan) inp handle Fail msg =>
wenzelm@23700
   159
              (if interactive then Output.error_msg msg else ();
wenzelm@27732
   160
                drain (Scan.unless (Scan.lift (Scan.one (Scan.is_stopper stopper))) (recover msg)) inp)));
wenzelm@23700
   161
  in (ys, (state', unget (xs', src'))) end;
wenzelm@23700
   162
wenzelm@6116
   163
fun source' init_state stopper scan recover src =
wenzelm@23700
   164
  make_source [] (init_state, src) default_prompt (drain_source' stopper scan recover);
wenzelm@6116
   165
wenzelm@6116
   166
wenzelm@6116
   167
(* non state-based *)
wenzelm@6116
   168
wenzelm@23700
   169
fun drain_source stopper scan opt_recover prompt =
wenzelm@23700
   170
  Scan.unlift (drain_source' stopper (Scan.lift scan)
wenzelm@23700
   171
    (Option.map (fn (int, r) => (int, Scan.lift o r)) opt_recover) prompt);
wenzelm@23700
   172
wenzelm@6116
   173
fun source stopper scan recover src =
wenzelm@23700
   174
  make_source [] src default_prompt (drain_source stopper scan recover);
wenzelm@6116
   175
wenzelm@6116
   176
wenzelm@6116
   177
end;