|
1 (* Title: Pure/Syntax/source.ML |
|
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 |
|
11 val set_prompt: string -> ('a, 'b) source -> ('a, 'b) source |
|
12 val get: ('a, 'b) source -> 'a list * ('a, 'b) source |
|
13 val unget: 'a list * ('a, 'b) source -> ('a, 'b) source |
|
14 val get_single: ('a, 'b) source -> ('a * ('a, 'b) source) option |
|
15 val exhaust: ('a, 'b) source -> 'a list |
|
16 val mapfilter: ('a -> 'b option) -> ('a, 'c) source -> ('b, ('a, 'c) source) source |
|
17 val filter: ('a -> bool) -> ('a, 'b) source -> ('a, ('a, 'b) source) source |
|
18 val of_list: 'a list -> ('a, 'a list) source |
|
19 val of_string: string -> (string, string list) source |
|
20 val of_file: string -> (string, string list) source |
|
21 val decorate_prompt_fn: (string -> string) ref |
|
22 val of_stream: TextIO.instream -> TextIO.outstream -> (string, unit) source |
|
23 val tty: (string, unit) source |
|
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 |
|
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, |
|
42 prompt: string, |
|
43 drain: string -> 'b -> 'a list * 'b}; |
|
44 |
|
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}) = |
|
54 make_source buffer info prompt drain; |
|
55 |
|
56 |
|
57 (* get / unget *) |
|
58 |
|
59 fun get (Source {buffer = [], info, prompt, drain}) = |
|
60 let val (xs, info') = drain prompt info |
|
61 in (xs, make_source [] info' prompt drain) end |
|
62 | get (Source {buffer, info, prompt, drain}) = |
|
63 (buffer, make_source [] info prompt drain); |
|
64 |
|
65 fun unget (xs, Source {buffer, info, prompt, drain}) = |
|
66 make_source (xs @ buffer) info prompt drain; |
|
67 |
|
68 |
|
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 |
|
75 ([], _) => None |
|
76 | (x :: xs, src') => Some (x, unget (xs, src'))); |
|
77 |
|
78 fun exhaust src = |
|
79 (case get src of |
|
80 ([], _) => [] |
|
81 | (xs, src') => xs @ exhaust src'); |
|
82 |
|
83 |
|
84 (* (map)filter *) |
|
85 |
|
86 fun drain_mapfilter f prompt src = |
|
87 let |
|
88 val (xs, src') = get_prompt prompt src; |
|
89 val xs' = Library.mapfilter f xs; |
|
90 in |
|
91 if null xs orelse not (null xs') then (xs', src') |
|
92 else drain_mapfilter f prompt src' |
|
93 end; |
|
94 |
|
95 fun mapfilter f src = make_source [] src default_prompt (drain_mapfilter f); |
|
96 fun filter pred = mapfilter (fn x => if pred x then Some x else None); |
|
97 |
|
98 |
|
99 |
|
100 (** build sources **) |
|
101 |
|
102 (* list source *) |
|
103 |
|
104 (*limiting the input buffer considerably improves performance*) |
|
105 val limit = 4000; |
|
106 |
|
107 fun drain_list _ xs = (take (limit, xs), drop (limit, xs)); |
|
108 |
|
109 fun of_list xs = make_source [] xs default_prompt drain_list; |
|
110 val of_string = of_list o explode; |
|
111 val of_file = of_string o File.read; |
|
112 |
|
113 |
|
114 (* stream source *) |
|
115 |
|
116 val decorate_prompt_fn = ref (fn s:string => s); |
|
117 |
|
118 fun drain_stream instream outstream prompt () = |
|
119 (TextIO.output (outstream, ! decorate_prompt_fn prompt); |
|
120 TextIO.flushOut outstream; |
|
121 (explode (TextIO.inputLine instream), ())); |
|
122 |
|
123 fun of_stream instream outstream = |
|
124 make_source [] () default_prompt (drain_stream instream outstream); |
|
125 |
|
126 val tty = of_stream TextIO.stdIn TextIO.stdOut; |
|
127 |
|
128 |
|
129 |
|
130 (** compose sources **) |
|
131 |
|
132 fun drain_source source stopper scan recover prompt src = |
|
133 source prompt get_prompt unget stopper scan recover src; |
|
134 |
|
135 |
|
136 (* state-based *) |
|
137 |
|
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); |
|
141 |
|
142 |
|
143 (* non state-based *) |
|
144 |
|
145 fun source stopper scan recover src = |
|
146 make_source [] src default_prompt |
|
147 (drain_source Scan.source stopper scan recover); |
|
148 |
|
149 |
|
150 end; |