Shells in OCaml
Simple pipelines
+147
-77
+19
TODO.md
+19
TODO.md
···
1
+
## Functionality
2
+
3
+
- [x] And or lists
4
+
- [ ] Pipelines
5
+
- [x] Simple
6
+
- Better structured concurrency handling, will eventually need a notion
7
+
of background/global Eio.Switch.t.
8
+
- [ ] Redirections
9
+
- [ ] Loops
10
+
- [ ] For loops
11
+
- [ ] While/Until loops
12
+
- [ ] Conditionals
13
+
- [ ] Substitutions
14
+
- [ ] Globs
15
+
- [ ] Traps
16
+
- [ ] Background Tasks
17
+
18
+
## Conformance Testing
19
+
+1
-8
src/bin/main.ml
+1
-8
src/bin/main.ml
···
14
14
if dump then Merry.Ast.Dump.pp Fmt.stdout ast
15
15
else
16
16
let _ctx, _ast =
17
-
let executor =
18
-
Merry_posix.Exec.
19
-
{
20
-
mgr =
21
-
(env#process_mgr
22
-
:> [ `Generic ] Eio.Process.mgr_ty Eio.Process.mgr);
23
-
}
24
-
in
17
+
let executor = Merry_posix.Exec.{ mgr = env#process_mgr } in
25
18
Shell.run
26
19
Shell.
27
20
{
+1
-1
src/lib/dune
+1
-1
src/lib/dune
+106
-64
src/lib/eval.ml
+106
-64
src/lib/eval.ml
···
109
109
in
110
110
(o#complete_command ast ctx, ast)
111
111
112
+
let stdout_for_pipeline ~sw = function
113
+
| [] -> (None, None)
114
+
| _ ->
115
+
let r, w = Eio_unix.pipe sw in
116
+
(Some r, Some (w :> Eio_unix.sink_ty Eio.Flow.sink))
117
+
112
118
let exec ctx (ast : Ast.complete_command) =
113
119
let command, _ = ast in
114
-
let execute_command p =
115
-
let h = List.hd p in
116
-
match h with
117
-
| Ast.SimpleCommand (Prefixed _) -> None
118
-
| Ast.SimpleCommand (Named (executable, None)) ->
119
-
E.exec ctx.executor (List.map word_component_to_string executable)
120
-
|> Option.some
121
-
| Ast.SimpleCommand (Named (executable, Some suffix)) ->
122
-
let args =
123
-
List.filter_map
124
-
(function
125
-
| Ast.Suffix_word w ->
126
-
Some (List.map word_component_to_string w)
127
-
| Ast.Suffix_redirect _ -> None)
128
-
suffix
129
-
in
130
-
E.exec ctx.executor
131
-
(List.map word_component_to_string executable @ List.concat args)
132
-
|> Option.some
133
-
| v ->
134
-
Fmt.epr "TODO: %a" Yojson.Safe.pp (Ast.command_to_yojson v);
135
-
failwith "Err"
120
+
let execute_commands local_switch p =
121
+
let rec loop (status_of_previous, stdout_of_previous) = function
122
+
| Ast.SimpleCommand (Prefixed _) :: next ->
123
+
loop (status_of_previous, stdout_of_previous) next
124
+
| Ast.SimpleCommand (Named (executable, None)) :: rest -> (
125
+
let some_read, some_write =
126
+
stdout_for_pipeline ~sw:local_switch rest
127
+
in
128
+
match stdout_of_previous with
129
+
| None ->
130
+
E.exec ctx.executor ?stdout:some_write
131
+
(List.map word_component_to_string executable)
132
+
|> Option.some
133
+
| Some stdout ->
134
+
let res =
135
+
E.exec ctx.executor ~stdin:stdout ?stdout:some_write
136
+
(List.map word_component_to_string executable)
137
+
in
138
+
Option.iter Eio.Flow.close some_write;
139
+
loop (Some res, some_read) rest)
140
+
| Ast.SimpleCommand (Named (executable, Some suffix)) :: rest -> (
141
+
let args =
142
+
List.filter_map
143
+
(function
144
+
| Ast.Suffix_word w ->
145
+
Some (List.map word_component_to_string w)
146
+
| Ast.Suffix_redirect _ -> None)
147
+
suffix
148
+
in
149
+
let some_read, some_write =
150
+
stdout_for_pipeline ~sw:local_switch rest
151
+
in
152
+
match stdout_of_previous with
153
+
| None ->
154
+
let res =
155
+
E.exec ctx.executor ?stdout:some_write
156
+
(List.map word_component_to_string executable
157
+
@ List.concat args)
158
+
|> Option.some
159
+
in
160
+
Option.iter Eio.Flow.close some_write;
161
+
loop (res, some_read) rest
162
+
| Some stdout ->
163
+
let res =
164
+
E.exec ctx.executor ~stdin:stdout ?stdout:some_write
165
+
(List.map word_component_to_string executable
166
+
@ List.concat args)
167
+
|> Option.some
168
+
in
169
+
Option.iter Eio.Flow.close some_write;
170
+
loop (res, some_read) rest)
171
+
| v :: _ ->
172
+
Fmt.epr "TODO: %a" Yojson.Safe.pp (Ast.command_to_yojson v);
173
+
failwith "Err"
174
+
| [] -> status_of_previous
175
+
in
176
+
loop (None, None) p
136
177
in
137
178
let pipeline = function
138
179
| Ast.Pipeline p -> (Fun.id, p)
139
180
| Ast.Pipeline_Bang p ->
140
181
(Option.map (fun i -> if Int.equal i 0 then -1 else 0), p)
141
182
in
142
-
let loop : Ast.clist -> int option = function
143
-
| Nlist.Singleton (c, _) ->
144
-
let rec fold :
145
-
Ast.and_or * int option ->
146
-
Ast.pipeline Ast.and_or_list ->
147
-
int option =
148
-
fun (sep, exit_so_far) pipe ->
149
-
match (sep, pipe) with
150
-
| And, Nlist.Singleton (p, _) -> (
151
-
match exit_so_far with
152
-
| Some 0 ->
153
-
let f, p = pipeline p in
154
-
f @@ execute_command p
155
-
| v -> v)
156
-
| Or, Nlist.Singleton (p, _) -> (
157
-
match exit_so_far with
158
-
| Some 0 -> Some 0
159
-
| _ ->
160
-
let f, p = pipeline p in
161
-
f @@ execute_command p)
162
-
| Noand_or, Nlist.Singleton (p, _) ->
163
-
let f, p = pipeline p in
164
-
f @@ execute_command p
165
-
| Noand_or, Nlist.Cons ((p, next_sep), rest) ->
166
-
let f, p = pipeline p in
167
-
fold (next_sep, f (execute_command p)) rest
168
-
| And, Nlist.Cons ((p, next_sep), rest) -> (
169
-
match exit_so_far with
170
-
| Some 0 ->
171
-
let f, p = pipeline p in
172
-
fold (next_sep, f (execute_command p)) rest
173
-
| (None | Some _) as v -> v)
174
-
| Or, Nlist.Cons ((p, next_sep), rest) -> (
175
-
match exit_so_far with
176
-
| Some 0 -> fold (next_sep, exit_so_far) rest
177
-
| None | Some _ ->
178
-
let f, p = pipeline p in
179
-
fold (next_sep, f (execute_command p)) rest)
180
-
in
181
-
fold (Noand_or, None) c
182
-
| _ -> Fmt.failwith "TODO!!!"
183
+
let loop : Eio.Switch.t -> Ast.clist -> int option =
184
+
fun sw -> function
185
+
| Nlist.Singleton (c, _) ->
186
+
let rec fold :
187
+
Ast.and_or * int option ->
188
+
Ast.pipeline Ast.and_or_list ->
189
+
int option =
190
+
fun (sep, exit_so_far) pipe ->
191
+
match (sep, pipe) with
192
+
| And, Nlist.Singleton (p, _) -> (
193
+
match exit_so_far with
194
+
| Some 0 ->
195
+
let f, p = pipeline p in
196
+
f @@ execute_commands sw p
197
+
| v -> v)
198
+
| Or, Nlist.Singleton (p, _) -> (
199
+
match exit_so_far with
200
+
| Some 0 -> Some 0
201
+
| _ ->
202
+
let f, p = pipeline p in
203
+
f @@ execute_commands sw p)
204
+
| Noand_or, Nlist.Singleton (p, _) ->
205
+
let f, p = pipeline p in
206
+
f @@ execute_commands sw p
207
+
| Noand_or, Nlist.Cons ((p, next_sep), rest) ->
208
+
let f, p = pipeline p in
209
+
fold (next_sep, f (execute_commands sw p)) rest
210
+
| And, Nlist.Cons ((p, next_sep), rest) -> (
211
+
match exit_so_far with
212
+
| Some 0 ->
213
+
let f, p = pipeline p in
214
+
fold (next_sep, f (execute_commands sw p)) rest
215
+
| (None | Some _) as v -> v)
216
+
| Or, Nlist.Cons ((p, next_sep), rest) -> (
217
+
match exit_so_far with
218
+
| Some 0 -> fold (next_sep, exit_so_far) rest
219
+
| None | Some _ ->
220
+
let f, p = pipeline p in
221
+
fold (next_sep, f (execute_commands sw p)) rest)
222
+
in
223
+
fold (Noand_or, None) c
224
+
| _ -> Fmt.failwith "TODO!!!"
183
225
in
184
-
(loop command, ctx, ast)
226
+
Eio.Switch.run @@ fun sw -> (loop sw command, ctx, ast)
185
227
186
228
let apply_pair (a, b) f = f a b
187
229
let ( ||> ) = apply_pair
+5
-3
src/lib/posix/merry_posix.ml
+5
-3
src/lib/posix/merry_posix.ml
···
3
3
module State = State
4
4
5
5
module Exec = struct
6
-
type t = { mgr : [ `Generic ] Eio.Process.mgr_ty Eio.Process.mgr }
6
+
type t = { mgr : Eio_unix.Process.mgr_ty Eio_unix.Process.mgr }
7
7
type fork_action = unit
8
8
9
-
let exec ?fork_actions:_ t s =
9
+
let exec ?fork_actions:_ ?stdin ?stdout ?stderr t s =
10
+
(* let fds = List.map (fun (i, fd) -> (i, fd, `Nonblocking)) fds in *)
10
11
Eio.Switch.run @@ fun sw ->
11
-
Eio.Process.spawn ~sw t.mgr s |> Eio.Process.await |> function
12
+
Eio.Process.spawn ~sw ?stdin ?stdout ?stderr t.mgr s |> Eio.Process.await
13
+
|> function
12
14
| `Exited n -> n
13
15
| `Signaled n -> n
14
16
end
+8
-1
src/lib/types.ml
+8
-1
src/lib/types.ml
···
29
29
(** A fork action is a piece of C-code to run inbetween the fork and the exec
30
30
*)
31
31
32
-
val exec : ?fork_actions:fork_action list -> t -> string list -> int
32
+
val exec :
33
+
?fork_actions:fork_action list ->
34
+
?stdin:[> Eio__Flow.source_ty ] Eio_unix.source ->
35
+
?stdout:_ Eio_unix.sink ->
36
+
?stderr:[> Eio__Flow.sink_ty ] Eio_unix.source ->
37
+
t ->
38
+
string list ->
39
+
int
33
40
(** Run a command in a child process *)
34
41
end