author | wenzelm |
Sun, 29 Nov 1998 13:15:50 +0100 | |
changeset 5988 | 1a2285f3db47 |
parent 5943 | 576a7f5e5e39 |
permissions | -rw-r--r-- |
4954
cf1404c3f7bb
changed get_single: ('a, 'b) source -> 'a option * ('a, 'b) source;
wenzelm
parents:
4946
diff
changeset
|
1 |
(* Title: Pure/Syntax/source.ML |
4939 | 2 |
ID: $Id$ |
3 |
Author: Markus Wenzel, TU Muenchen |
|
4 |
||
5 |
Co-algebraic data sources. |
|
6 |
*) |
|
7 |
||
8 |
signature SOURCE = |
|
9 |
sig |
|
10 |
type ('a, 'b) source |
|
4946 | 11 |
val set_prompt: string -> ('a, 'b) source -> ('a, 'b) source |
12 |
val get: ('a, 'b) source -> 'a list * ('a, 'b) source |
|
4939 | 13 |
val unget: 'a list * ('a, 'b) source -> ('a, 'b) source |
4983
2c567fcdb36d
changed get_single: ('a, 'b) source -> ('a * ('a, 'b) source) option;
wenzelm
parents:
4976
diff
changeset
|
14 |
val get_single: ('a, 'b) source -> ('a * ('a, 'b) source) option |
4946 | 15 |
val exhaust: ('a, 'b) source -> 'a list |
4976
19f48dafe5d3
added mapfilter: ('a -> 'b option) -> ('a, 'c) source -> ('b, ('a, 'c)
wenzelm
parents:
4960
diff
changeset
|
16 |
val mapfilter: ('a -> 'b option) -> ('a, 'c) source -> ('b, ('a, 'c) source) source |
4939 | 17 |
val filter: ('a -> bool) -> ('a, 'b) source -> ('a, ('a, 'b) source) source |
4946 | 18 |
val of_list: 'a list -> ('a, 'a list) source |
19 |
val of_string: string -> (string, string list) source |
|
5019 | 20 |
val of_file: string -> (string, string list) source |
5988 | 21 |
val decorate_prompt_fn: (string -> string) ref |
4939 | 22 |
val of_stream: TextIO.instream -> TextIO.outstream -> (string, unit) source |
23 |
val tty: (string, unit) source |
|
4960 | 24 |
val source': 'a -> 'b * ('b -> bool) -> ('a * 'b list -> 'c list * ('a * 'b list)) -> |
25 |
('a * 'b list -> 'd * ('a * 'b list)) option -> |
|
26 |
('b, 'e) source -> ('c, 'a * ('b, 'e) source) source |
|
27 |
val source: 'a * ('a -> bool) -> ('a list -> 'b list * 'a list) -> |
|
28 |
('a list -> 'c * 'a list) option -> |
|
29 |
('a, 'd) source -> ('b, ('a, 'd) source) source |
|
4939 | 30 |
end; |
31 |
||
32 |
structure Source: SOURCE = |
|
33 |
struct |
|
34 |
||
35 |
||
36 |
(** datatype source **) |
|
37 |
||
38 |
datatype ('a, 'b) source = |
|
39 |
Source of |
|
40 |
{buffer: 'a list, |
|
41 |
info: 'b, |
|
4954
cf1404c3f7bb
changed get_single: ('a, 'b) source -> 'a option * ('a, 'b) source;
wenzelm
parents:
4946
diff
changeset
|
42 |
prompt: string, |
4939 | 43 |
drain: string -> 'b -> 'a list * 'b}; |
44 |
||
4946 | 45 |
fun make_source buffer info prompt drain = |
46 |
Source {buffer = buffer, info = info, prompt = prompt, drain = drain}; |
|
47 |
||
48 |
||
49 |
(* prompt *) |
|
50 |
||
51 |
val default_prompt = "> "; |
|
52 |
||
53 |
fun set_prompt prompt (Source {buffer, info, prompt = _, drain}) = |
|
4954
cf1404c3f7bb
changed get_single: ('a, 'b) source -> 'a option * ('a, 'b) source;
wenzelm
parents:
4946
diff
changeset
|
54 |
make_source buffer info prompt drain; |
4939 | 55 |
|
56 |
||
57 |
(* get / unget *) |
|
58 |
||
4946 | 59 |
fun get (Source {buffer = [], info, prompt, drain}) = |
4954
cf1404c3f7bb
changed get_single: ('a, 'b) source -> 'a option * ('a, 'b) source;
wenzelm
parents:
4946
diff
changeset
|
60 |
let val (xs, info') = drain prompt info |
4946 | 61 |
in (xs, make_source [] info' prompt drain) end |
62 |
| get (Source {buffer, info, prompt, drain}) = |
|
63 |
(buffer, make_source [] info prompt drain); |
|
4939 | 64 |
|
4946 | 65 |
fun unget (xs, Source {buffer, info, prompt, drain}) = |
66 |
make_source (xs @ buffer) info prompt drain; |
|
4939 | 67 |
|
68 |
||
4946 | 69 |
(* variations on get *) |
70 |
||
71 |
fun get_prompt prompt src = get (set_prompt prompt src); |
|
72 |
||
73 |
fun get_single src = |
|
74 |
(case get src of |
|
4983
2c567fcdb36d
changed get_single: ('a, 'b) source -> ('a * ('a, 'b) source) option;
wenzelm
parents:
4976
diff
changeset
|
75 |
([], _) => None |
2c567fcdb36d
changed get_single: ('a, 'b) source -> ('a * ('a, 'b) source) option;
wenzelm
parents:
4976
diff
changeset
|
76 |
| (x :: xs, src') => Some (x, unget (xs, src'))); |
4939 | 77 |
|
4946 | 78 |
fun exhaust src = |
79 |
(case get src of |
|
4939 | 80 |
([], _) => [] |
4946 | 81 |
| (xs, src') => xs @ exhaust src'); |
4939 | 82 |
|
83 |
||
4976
19f48dafe5d3
added mapfilter: ('a -> 'b option) -> ('a, 'c) source -> ('b, ('a, 'c)
wenzelm
parents:
4960
diff
changeset
|
84 |
(* (map)filter *) |
4939 | 85 |
|
4976
19f48dafe5d3
added mapfilter: ('a -> 'b option) -> ('a, 'c) source -> ('b, ('a, 'c)
wenzelm
parents:
4960
diff
changeset
|
86 |
fun drain_mapfilter f prompt src = |
4939 | 87 |
let |
4976
19f48dafe5d3
added mapfilter: ('a -> 'b option) -> ('a, 'c) source -> ('b, ('a, 'c)
wenzelm
parents:
4960
diff
changeset
|
88 |
val (xs, src') = get_prompt prompt src; |
19f48dafe5d3
added mapfilter: ('a -> 'b option) -> ('a, 'c) source -> ('b, ('a, 'c)
wenzelm
parents:
4960
diff
changeset
|
89 |
val xs' = Library.mapfilter f xs; |
4939 | 90 |
in |
4976
19f48dafe5d3
added mapfilter: ('a -> 'b option) -> ('a, 'c) source -> ('b, ('a, 'c)
wenzelm
parents:
4960
diff
changeset
|
91 |
if null xs orelse not (null xs') then (xs', src') |
19f48dafe5d3
added mapfilter: ('a -> 'b option) -> ('a, 'c) source -> ('b, ('a, 'c)
wenzelm
parents:
4960
diff
changeset
|
92 |
else drain_mapfilter f prompt src' |
4939 | 93 |
end; |
94 |
||
4976
19f48dafe5d3
added mapfilter: ('a -> 'b option) -> ('a, 'c) source -> ('b, ('a, 'c)
wenzelm
parents:
4960
diff
changeset
|
95 |
fun mapfilter f src = make_source [] src default_prompt (drain_mapfilter f); |
19f48dafe5d3
added mapfilter: ('a -> 'b option) -> ('a, 'c) source -> ('b, ('a, 'c)
wenzelm
parents:
4960
diff
changeset
|
96 |
fun filter pred = mapfilter (fn x => if pred x then Some x else None); |
4939 | 97 |
|
98 |
||
99 |
||
100 |
(** build sources **) |
|
101 |
||
102 |
(* list source *) |
|
103 |
||
4954
cf1404c3f7bb
changed get_single: ('a, 'b) source -> 'a option * ('a, 'b) source;
wenzelm
parents:
4946
diff
changeset
|
104 |
(*limiting the input buffer considerably improves performance*) |
4946 | 105 |
val limit = 4000; |
4939 | 106 |
|
4946 | 107 |
fun drain_list _ xs = (take (limit, xs), drop (limit, xs)); |
4939 | 108 |
|
4954
cf1404c3f7bb
changed get_single: ('a, 'b) source -> 'a option * ('a, 'b) source;
wenzelm
parents:
4946
diff
changeset
|
109 |
fun of_list xs = make_source [] xs default_prompt drain_list; |
cf1404c3f7bb
changed get_single: ('a, 'b) source -> 'a option * ('a, 'b) source;
wenzelm
parents:
4946
diff
changeset
|
110 |
val of_string = of_list o explode; |
5019 | 111 |
val of_file = of_string o File.read; |
4939 | 112 |
|
113 |
||
114 |
(* stream source *) |
|
115 |
||
5988 | 116 |
val decorate_prompt_fn = ref (fn s:string => s); |
5943 | 117 |
|
4939 | 118 |
fun drain_stream instream outstream prompt () = |
5988 | 119 |
(TextIO.output (outstream, ! decorate_prompt_fn prompt); |
4939 | 120 |
TextIO.flushOut outstream; |
121 |
(explode (TextIO.inputLine instream), ())); |
|
122 |
||
123 |
fun of_stream instream outstream = |
|
4954
cf1404c3f7bb
changed get_single: ('a, 'b) source -> 'a option * ('a, 'b) source;
wenzelm
parents:
4946
diff
changeset
|
124 |
make_source [] () default_prompt (drain_stream instream outstream); |
4939 | 125 |
|
126 |
val tty = of_stream TextIO.stdIn TextIO.stdOut; |
|
127 |
||
128 |
||
129 |
||
130 |
(** compose sources **) |
|
131 |
||
4960 | 132 |
fun drain_source source stopper scan recover prompt src = |
133 |
source prompt get_prompt unget stopper scan recover src; |
|
4939 | 134 |
|
4954
cf1404c3f7bb
changed get_single: ('a, 'b) source -> 'a option * ('a, 'b) source;
wenzelm
parents:
4946
diff
changeset
|
135 |
|
cf1404c3f7bb
changed get_single: ('a, 'b) source -> 'a option * ('a, 'b) source;
wenzelm
parents:
4946
diff
changeset
|
136 |
(* state-based *) |
4939 | 137 |
|
4960 | 138 |
fun source' init_state stopper scan recover src = |
139 |
make_source [] (init_state, src) default_prompt |
|
140 |
(drain_source Scan.source' stopper scan recover); |
|
4939 | 141 |
|
142 |
||
4954
cf1404c3f7bb
changed get_single: ('a, 'b) source -> 'a option * ('a, 'b) source;
wenzelm
parents:
4946
diff
changeset
|
143 |
(* non state-based *) |
4939 | 144 |
|
4960 | 145 |
fun source stopper scan recover src = |
146 |
make_source [] src default_prompt |
|
147 |
(drain_source Scan.source stopper scan recover); |
|
4939 | 148 |
|
149 |
||
150 |
end; |