src/Pure/Syntax/source.ML
changeset 6116 8ba2f25610f7
parent 6115 c70bce7deb0f
child 6117 f9aad8ccd590
     1.1 --- a/src/Pure/Syntax/source.ML	Wed Jan 13 12:16:34 1999 +0100
     1.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.3 @@ -1,150 +0,0 @@
     1.4 -(*  Title:      Pure/Syntax/source.ML
     1.5 -    ID:         $Id$
     1.6 -    Author:     Markus Wenzel, TU Muenchen
     1.7 -
     1.8 -Co-algebraic data sources.
     1.9 -*)
    1.10 -
    1.11 -signature SOURCE =
    1.12 -sig
    1.13 -  type ('a, 'b) source
    1.14 -  val set_prompt: string -> ('a, 'b) source -> ('a, 'b) source
    1.15 -  val get: ('a, 'b) source -> 'a list * ('a, 'b) source
    1.16 -  val unget: 'a list * ('a, 'b) source -> ('a, 'b) source
    1.17 -  val get_single: ('a, 'b) source -> ('a * ('a, 'b) source) option
    1.18 -  val exhaust: ('a, 'b) source -> 'a list
    1.19 -  val mapfilter: ('a -> 'b option) -> ('a, 'c) source -> ('b, ('a, 'c) source) source
    1.20 -  val filter: ('a -> bool) -> ('a, 'b) source -> ('a, ('a, 'b) source) source
    1.21 -  val of_list: 'a list -> ('a, 'a list) source
    1.22 -  val of_string: string -> (string, string list) source
    1.23 -  val of_file: string -> (string, string list) source
    1.24 -  val decorate_prompt_fn: (string -> string) ref
    1.25 -  val of_stream: TextIO.instream -> TextIO.outstream -> (string, unit) source
    1.26 -  val tty: (string, unit) source
    1.27 -  val source': 'a -> 'b * ('b -> bool) -> ('a * 'b list -> 'c list * ('a * 'b list)) ->
    1.28 -    ('a * 'b list -> 'd * ('a * 'b list)) option ->
    1.29 -    ('b, 'e) source -> ('c, 'a * ('b, 'e) source) source
    1.30 -  val source: 'a * ('a -> bool) -> ('a list -> 'b list * 'a list) ->
    1.31 -    ('a list -> 'c * 'a list) option ->
    1.32 -    ('a, 'd) source -> ('b, ('a, 'd) source) source
    1.33 -end;
    1.34 -
    1.35 -structure Source: SOURCE =
    1.36 -struct
    1.37 -
    1.38 -
    1.39 -(** datatype source **)
    1.40 -
    1.41 -datatype ('a, 'b) source =
    1.42 -  Source of
    1.43 -   {buffer: 'a list,
    1.44 -    info: 'b,
    1.45 -    prompt: string,
    1.46 -    drain: string -> 'b -> 'a list * 'b};
    1.47 -
    1.48 -fun make_source buffer info prompt drain =
    1.49 -  Source {buffer = buffer, info = info, prompt = prompt, drain = drain};
    1.50 -
    1.51 -
    1.52 -(* prompt *)
    1.53 -
    1.54 -val default_prompt = "> ";
    1.55 -
    1.56 -fun set_prompt prompt (Source {buffer, info, prompt = _, drain}) =
    1.57 -  make_source buffer info prompt drain;
    1.58 -
    1.59 -
    1.60 -(* get / unget *)
    1.61 -
    1.62 -fun get (Source {buffer = [], info, prompt, drain}) =
    1.63 -      let val (xs, info') = drain prompt info
    1.64 -      in (xs, make_source [] info' prompt drain) end
    1.65 -  | get (Source {buffer, info, prompt, drain}) =
    1.66 -      (buffer, make_source [] info prompt drain);
    1.67 -
    1.68 -fun unget (xs, Source {buffer, info, prompt, drain}) =
    1.69 -  make_source (xs @ buffer) info prompt drain;
    1.70 -
    1.71 -
    1.72 -(* variations on get *)
    1.73 -
    1.74 -fun get_prompt prompt src = get (set_prompt prompt src);
    1.75 -
    1.76 -fun get_single src =
    1.77 -  (case get src of
    1.78 -    ([], _) => None
    1.79 -  | (x :: xs, src') => Some (x, unget (xs, src')));
    1.80 -
    1.81 -fun exhaust src =
    1.82 -  (case get src of
    1.83 -    ([], _) => []
    1.84 -  | (xs, src') => xs @ exhaust src');
    1.85 -
    1.86 -
    1.87 -(* (map)filter *)
    1.88 -
    1.89 -fun drain_mapfilter f prompt src =
    1.90 -  let
    1.91 -    val (xs, src') = get_prompt prompt src;
    1.92 -    val xs' = Library.mapfilter f xs;
    1.93 -  in
    1.94 -    if null xs orelse not (null xs') then (xs', src')
    1.95 -    else drain_mapfilter f prompt src'
    1.96 -  end;
    1.97 -
    1.98 -fun mapfilter f src = make_source [] src default_prompt (drain_mapfilter f);
    1.99 -fun filter pred = mapfilter (fn x => if pred x then Some x else None);
   1.100 -
   1.101 -
   1.102 -
   1.103 -(** build sources **)
   1.104 -
   1.105 -(* list source *)
   1.106 -
   1.107 -(*limiting the input buffer considerably improves performance*)
   1.108 -val limit = 4000;
   1.109 -
   1.110 -fun drain_list _ xs = (take (limit, xs), drop (limit, xs));
   1.111 -
   1.112 -fun of_list xs = make_source [] xs default_prompt drain_list;
   1.113 -val of_string = of_list o explode;
   1.114 -val of_file = of_string o File.read;
   1.115 -
   1.116 -
   1.117 -(* stream source *)
   1.118 -
   1.119 -val decorate_prompt_fn = ref (fn s:string => s);
   1.120 -
   1.121 -fun drain_stream instream outstream prompt () =
   1.122 -  (TextIO.output (outstream, ! decorate_prompt_fn prompt);
   1.123 -    TextIO.flushOut outstream;
   1.124 -    (explode (TextIO.inputLine instream), ()));
   1.125 -
   1.126 -fun of_stream instream outstream =
   1.127 -  make_source [] () default_prompt (drain_stream instream outstream);
   1.128 -
   1.129 -val tty = of_stream TextIO.stdIn TextIO.stdOut;
   1.130 -
   1.131 -
   1.132 -
   1.133 -(** compose sources **)
   1.134 -
   1.135 -fun drain_source source stopper scan recover prompt src =
   1.136 -  source prompt get_prompt unget stopper scan recover src;
   1.137 -
   1.138 -
   1.139 -(* state-based *)
   1.140 -
   1.141 -fun source' init_state stopper scan recover src =
   1.142 -  make_source [] (init_state, src) default_prompt
   1.143 -    (drain_source Scan.source' stopper scan recover);
   1.144 -
   1.145 -
   1.146 -(* non state-based *)
   1.147 -
   1.148 -fun source stopper scan recover src =
   1.149 -  make_source [] src default_prompt
   1.150 -    (drain_source Scan.source stopper scan recover);
   1.151 -
   1.152 -
   1.153 -end;