src/Pure/General/source.ML
author wenzelm
Mon Jul 09 11:44:22 2007 +0200 (2007-07-09)
changeset 23661 b3f05bc680b6
parent 23139 aa899bce7c3b
child 23675 2d618c190466
permissions -rw-r--r--
prompt: plain string, not output;
wenzelm@6118
     1
(*  Title:      Pure/General/source.ML
wenzelm@6116
     2
    ID:         $Id$
wenzelm@6116
     3
    Author:     Markus Wenzel, TU Muenchen
wenzelm@6116
     4
wenzelm@8806
     5
Coalgebraic data sources -- efficient purely functional input streams.
wenzelm@6116
     6
*)
wenzelm@6116
     7
wenzelm@6116
     8
signature SOURCE =
wenzelm@6116
     9
sig
wenzelm@6116
    10
  type ('a, 'b) source
wenzelm@6681
    11
  val default_prompt: string
wenzelm@6116
    12
  val set_prompt: string -> ('a, 'b) source -> ('a, 'b) source
wenzelm@6116
    13
  val get: ('a, 'b) source -> 'a list * ('a, 'b) source
wenzelm@6116
    14
  val unget: 'a list * ('a, 'b) source -> ('a, 'b) source
wenzelm@6116
    15
  val get_single: ('a, 'b) source -> ('a * ('a, 'b) source) option
wenzelm@6116
    16
  val exhaust: ('a, 'b) source -> 'a list
wenzelm@19485
    17
  val map_filter: ('a -> 'b option) -> ('a, 'c) source -> ('b, ('a, 'c) source) source
wenzelm@6116
    18
  val filter: ('a -> bool) -> ('a, 'b) source -> ('a, ('a, 'b) source) source
wenzelm@6116
    19
  val of_list: 'a list -> ('a, 'a list) source
wenzelm@6116
    20
  val of_string: string -> (string, string list) source
wenzelm@9123
    21
  val exhausted: ('a, 'b) source -> ('a, 'a list) source
wenzelm@6116
    22
  val of_stream: TextIO.instream -> TextIO.outstream -> (string, unit) source
wenzelm@6116
    23
  val tty: (string, unit) source
wenzelm@6116
    24
  val source': 'a -> 'b * ('b -> bool) -> ('a * 'b list -> 'c list * ('a * 'b list)) ->
wenzelm@10746
    25
    ('a * 'b list -> 'c list * ('a * 'b list)) option ->
wenzelm@6116
    26
    ('b, 'e) source -> ('c, 'a * ('b, 'e) source) source
wenzelm@6116
    27
  val source: 'a * ('a -> bool) -> ('a list -> 'b list * 'a list) ->
wenzelm@10746
    28
    ('a list -> 'b list * 'a list) option ->
wenzelm@6116
    29
    ('a, 'd) source -> ('b, ('a, 'd) source) source
wenzelm@6116
    30
end;
wenzelm@6116
    31
wenzelm@6116
    32
structure Source: SOURCE =
wenzelm@6116
    33
struct
wenzelm@6116
    34
wenzelm@6116
    35
wenzelm@6116
    36
(** datatype source **)
wenzelm@6116
    37
wenzelm@6116
    38
datatype ('a, 'b) source =
wenzelm@6116
    39
  Source of
wenzelm@6116
    40
   {buffer: 'a list,
wenzelm@6116
    41
    info: 'b,
wenzelm@6116
    42
    prompt: string,
wenzelm@6116
    43
    drain: string -> 'b -> 'a list * 'b};
wenzelm@6116
    44
wenzelm@6116
    45
fun make_source buffer info prompt drain =
wenzelm@6116
    46
  Source {buffer = buffer, info = info, prompt = prompt, drain = drain};
wenzelm@6116
    47
wenzelm@6116
    48
wenzelm@6116
    49
(* prompt *)
wenzelm@6116
    50
wenzelm@6116
    51
val default_prompt = "> ";
wenzelm@6116
    52
wenzelm@6116
    53
fun set_prompt prompt (Source {buffer, info, prompt = _, drain}) =
wenzelm@6116
    54
  make_source buffer info prompt drain;
wenzelm@6116
    55
wenzelm@6116
    56
wenzelm@6116
    57
(* get / unget *)
wenzelm@6116
    58
wenzelm@6116
    59
fun get (Source {buffer = [], info, prompt, drain}) =
wenzelm@6116
    60
      let val (xs, info') = drain prompt info
wenzelm@6116
    61
      in (xs, make_source [] info' prompt drain) end
wenzelm@6116
    62
  | get (Source {buffer, info, prompt, drain}) =
wenzelm@6116
    63
      (buffer, make_source [] info prompt drain);
wenzelm@6116
    64
wenzelm@6116
    65
fun unget (xs, Source {buffer, info, prompt, drain}) =
wenzelm@6116
    66
  make_source (xs @ buffer) info prompt drain;
wenzelm@6116
    67
wenzelm@6116
    68
wenzelm@6116
    69
(* variations on get *)
wenzelm@6116
    70
wenzelm@6116
    71
fun get_prompt prompt src = get (set_prompt prompt src);
wenzelm@6116
    72
wenzelm@6116
    73
fun get_single src =
wenzelm@6116
    74
  (case get src of
skalberg@15531
    75
    ([], _) => NONE
skalberg@15531
    76
  | (x :: xs, src') => SOME (x, unget (xs, src')));
wenzelm@6116
    77
wenzelm@6116
    78
fun exhaust src =
wenzelm@6116
    79
  (case get src of
wenzelm@6116
    80
    ([], _) => []
wenzelm@6116
    81
  | (xs, src') => xs @ exhaust src');
wenzelm@6116
    82
wenzelm@6116
    83
wenzelm@6116
    84
(* (map)filter *)
wenzelm@6116
    85
wenzelm@19485
    86
fun drain_map_filter f prompt src =
wenzelm@6116
    87
  let
wenzelm@6116
    88
    val (xs, src') = get_prompt prompt src;
wenzelm@19485
    89
    val xs' = map_filter f xs;
wenzelm@6116
    90
  in
wenzelm@6116
    91
    if null xs orelse not (null xs') then (xs', src')
wenzelm@19485
    92
    else drain_map_filter f prompt src'
wenzelm@6116
    93
  end;
wenzelm@6116
    94
wenzelm@19485
    95
fun map_filter f src = make_source [] src default_prompt (drain_map_filter f);
wenzelm@19485
    96
fun filter pred = map_filter (fn x => if pred x then SOME x else NONE);
wenzelm@6116
    97
wenzelm@6116
    98
wenzelm@6116
    99
wenzelm@6116
   100
(** build sources **)
wenzelm@6116
   101
wenzelm@6116
   102
(* list source *)
wenzelm@6116
   103
wenzelm@14727
   104
fun of_list xs = make_source [] xs default_prompt (fn _ => fn xs => (xs, []));
wenzelm@6116
   105
val of_string = of_list o explode;
wenzelm@6181
   106
wenzelm@9123
   107
fun exhausted src = of_list (exhaust src);
wenzelm@9123
   108
wenzelm@6116
   109
wenzelm@6116
   110
(* stream source *)
wenzelm@6116
   111
wenzelm@20737
   112
fun slurp_input instream =
wenzelm@20737
   113
  let
wenzelm@20737
   114
    fun slurp () =
wenzelm@20737
   115
      (case TextIO.canInput (instream, 1) handle IO.Io _ => NONE of
wenzelm@20737
   116
        NONE => []
wenzelm@20737
   117
      | SOME 0 => []
wenzelm@20737
   118
      | SOME _ => TextIO.input instream :: slurp ());
wenzelm@20737
   119
  in maps explode (slurp ()) end;
wenzelm@20737
   120
wenzelm@6116
   121
fun drain_stream instream outstream prompt () =
wenzelm@20737
   122
  let val input = slurp_input instream in
wenzelm@20737
   123
    if exists (fn c => c = "\n") input then (input, ())
wenzelm@20737
   124
    else
wenzelm@23661
   125
      (TextIO.output (outstream, Output.output prompt);
wenzelm@20737
   126
        TextIO.flushOut outstream;
wenzelm@23139
   127
        (case TextIO.inputLine instream of
wenzelm@23139
   128
          SOME line => (input @ explode line, ())
wenzelm@23139
   129
        | NONE => (input, ())))
wenzelm@20737
   130
  end;
wenzelm@6116
   131
wenzelm@6116
   132
fun of_stream instream outstream =
wenzelm@6116
   133
  make_source [] () default_prompt (drain_stream instream outstream);
wenzelm@6116
   134
wenzelm@6116
   135
val tty = of_stream TextIO.stdIn TextIO.stdOut;
wenzelm@6116
   136
wenzelm@6116
   137
wenzelm@6116
   138
wenzelm@6116
   139
(** compose sources **)
wenzelm@6116
   140
wenzelm@6116
   141
fun drain_source source stopper scan recover prompt src =
wenzelm@6116
   142
  source prompt get_prompt unget stopper scan recover src;
wenzelm@6116
   143
wenzelm@6116
   144
wenzelm@6116
   145
(* state-based *)
wenzelm@6116
   146
wenzelm@6116
   147
fun source' init_state stopper scan recover src =
wenzelm@6116
   148
  make_source [] (init_state, src) default_prompt
wenzelm@6116
   149
    (drain_source Scan.source' stopper scan recover);
wenzelm@6116
   150
wenzelm@6116
   151
wenzelm@6116
   152
(* non state-based *)
wenzelm@6116
   153
wenzelm@6116
   154
fun source stopper scan recover src =
wenzelm@6116
   155
  make_source [] src default_prompt
wenzelm@6116
   156
    (drain_source Scan.source stopper scan recover);
wenzelm@6116
   157
wenzelm@6116
   158
wenzelm@6116
   159
end;