Shells in OCaml
Functions
Adds simple function application. Also fixes the back to front command
lists!
+111
-77
+2
src/bin/main.ml
+2
src/bin/main.ml
+4
-4
src/lib/ast.ml
+4
-4
src/lib/ast.ml
···
148
148
let rest = term a.value in
149
149
let b = separator b.value in
150
150
let c = and_or c.value in
151
-
Nslist.cons b c rest
151
+
Nslist.append rest (Nslist.singleton b c)
152
152
| Term_AndOr a ->
153
153
let a = and_or a.value in
154
154
Nslist.singleton Semicolon a
···
321
321
| FunctionDefinition_Fname_Lparen_Rparen_LineBreak_FunctionBody (a, _, c) ->
322
322
let CST.(Fname_Name (Name a)) = a.value in
323
323
let c = function_body c.value in
324
-
Function_definition (a, c)
324
+
(a, c)
325
325
326
326
and function_body : CST.function_body -> function_body =
327
327
fun x ->
328
328
match x with
329
329
| FunctionBody_CompoundCommand a ->
330
330
let a = compound_command a.value in
331
-
Function_body (a, [])
331
+
(a, [])
332
332
| FunctionBody_CompoundCommand_RedirectList (a, b) ->
333
333
let a = compound_command a.value in
334
334
let b = redirect_list b.value in
335
-
Function_body (a, b)
335
+
(a, b)
336
336
337
337
and brace_group : CST.brace_group -> brace_group =
338
338
fun x ->
+79
-68
src/lib/eval.ml
+79
-68
src/lib/eval.ml
···
39
39
background_jobs : J.t list;
40
40
last_background_process : string;
41
41
async_switch : Eio.Switch.t;
42
+
program : string;
42
43
argv : string array;
44
+
functions : (string * Ast.compound_command) list;
43
45
}
44
46
45
47
let clear_local_state ctx = { ctx with local_state = [] }
···
271
273
(Ast.SimpleCommand (Named (executable, suffix)) :: rest)
272
274
| Ast.SimpleCommand (Named (executable, None)) :: rest -> (
273
275
let ctx, executable = expand_cst ctx executable in
274
-
match
275
-
Built_ins.of_args
276
-
[ handle_word_components_to_string ctx executable ]
277
-
with
276
+
let executable = handle_word_components_to_string ctx executable in
277
+
match Built_ins.of_args [ executable ] with
278
278
| Some (Ok bi) ->
279
279
let ctx = handle_built_in ctx bi in
280
280
let built_in = ctx >|= fun _ -> () in
···
283
283
| Some (Error _) ->
284
284
(ctx, handle_job ~pgid job (`Built_in (Exit.nonzero () 1)))
285
285
| None -> (
286
-
let some_read, some_write =
287
-
stdout_for_pipeline ctx ~sw:pipeline_switch rest
288
-
in
289
-
match stdout_of_previous with
290
-
| None ->
291
-
let executable =
292
-
handle_word_components_to_string ctx executable
293
-
in
294
-
let ctx, job =
295
-
exec_process ctx job ?stdout:some_write ~pgid [ executable ]
296
-
in
297
-
Option.iter Eio.Flow.close some_write;
298
-
loop ctx job (pgid, some_read) rest
299
-
| Some stdout ->
300
-
let executable =
301
-
handle_word_components_to_string ctx executable
302
-
in
303
-
let ctx, job =
304
-
exec_process ctx job ~stdin:stdout ?stdout:some_write ~pgid
305
-
[ executable ]
286
+
match
287
+
handle_function_application ctx ~name:executable [ executable ]
288
+
with
289
+
| Some ctx ->
290
+
(* TODO: Proper job stuff and redirects etc. *)
291
+
loop (Exit.value ctx) job (pgid, stdout_of_previous) rest
292
+
| None -> (
293
+
let some_read, some_write =
294
+
stdout_for_pipeline ctx ~sw:pipeline_switch rest
306
295
in
307
-
Option.iter Eio.Flow.close some_write;
308
-
loop ctx job (pgid, some_read) rest))
296
+
match stdout_of_previous with
297
+
| None ->
298
+
let ctx, job =
299
+
exec_process ctx job ?stdout:some_write ~pgid
300
+
[ executable ]
301
+
in
302
+
Option.iter Eio.Flow.close some_write;
303
+
loop ctx job (pgid, some_read) rest
304
+
| Some stdout ->
305
+
let ctx, job =
306
+
exec_process ctx job ~stdin:stdout ?stdout:some_write
307
+
~pgid [ executable ]
308
+
in
309
+
Option.iter Eio.Flow.close some_write;
310
+
loop ctx job (pgid, some_read) rest)))
309
311
| Ast.SimpleCommand (Named (executable, Some suffix)) :: rest -> (
310
312
let ctx, executable = expand_cst ctx executable in
313
+
let executable = handle_word_components_to_string ctx executable in
311
314
let ctx, suffix = expand_redirects (ctx, []) suffix in
312
315
let args = args ctx suffix in
313
-
match
314
-
Built_ins.of_args
315
-
(handle_word_components_to_string ctx executable :: args)
316
-
with
316
+
match Built_ins.of_args (executable :: args) with
317
317
| Some (Ok bi) ->
318
318
let ctx = handle_built_in ctx bi in
319
319
let built_in = ctx >|= fun _ -> () in
···
322
322
| Some (Error _) ->
323
323
(ctx, handle_job ~pgid job (`Built_in (Exit.nonzero () 1)))
324
324
| None -> (
325
-
let redirect =
326
-
List.fold_left
327
-
(fun acc -> function
328
-
| Ast.Suffix_word _ -> acc
329
-
| Ast.Suffix_redirect rdr ->
330
-
handle_one_redirection ~sw:pipeline_switch ctx rdr
331
-
:: acc)
332
-
[] suffix
333
-
|> List.rev |> List.filter_map Fun.id
334
-
in
335
-
let some_read, some_write =
336
-
stdout_for_pipeline ~sw:pipeline_switch ctx rest
337
-
in
338
-
match stdout_of_previous with
339
-
| None ->
340
-
let executable =
341
-
handle_word_components_to_string ctx executable
325
+
match
326
+
handle_function_application ctx ~name:executable
327
+
(ctx.program :: args)
328
+
with
329
+
| Some ctx ->
330
+
(* TODO: Proper job stuff and redirects etc. *)
331
+
loop (Exit.value ctx) job (pgid, stdout_of_previous) rest
332
+
| None -> (
333
+
let redirect =
334
+
List.fold_left
335
+
(fun acc -> function
336
+
| Ast.Suffix_word _ -> acc
337
+
| Ast.Suffix_redirect rdr ->
338
+
handle_one_redirection ~sw:pipeline_switch ctx rdr
339
+
:: acc)
340
+
[] suffix
341
+
|> List.rev |> List.filter_map Fun.id
342
342
in
343
-
let ctx, job =
344
-
exec_process ctx job ~fds:redirect ?stdout:some_write ~pgid
345
-
(executable :: args)
343
+
let some_read, some_write =
344
+
stdout_for_pipeline ~sw:pipeline_switch ctx rest
346
345
in
347
-
Option.iter Eio.Flow.close some_write;
348
-
loop ctx job (pgid, some_read) rest
349
-
| Some stdout ->
350
-
let executable =
351
-
handle_word_components_to_string ctx executable
352
-
in
353
-
let ctx, job =
354
-
exec_process ctx job ~fds:redirect ~stdin:stdout
355
-
?stdout:some_write ~pgid (executable :: args)
356
-
in
357
-
Option.iter Eio.Flow.close some_write;
358
-
loop ctx job (pgid, some_read) rest))
359
-
| CompoundCommand (c, rdrs) :: _rest ->
346
+
match stdout_of_previous with
347
+
| None ->
348
+
let ctx, job =
349
+
exec_process ctx job ~fds:redirect ?stdout:some_write
350
+
~pgid (executable :: args)
351
+
in
352
+
Option.iter Eio.Flow.close some_write;
353
+
loop ctx job (pgid, some_read) rest
354
+
| Some stdout ->
355
+
let ctx, job =
356
+
exec_process ctx job ~fds:redirect ~stdin:stdout
357
+
?stdout:some_write ~pgid (executable :: args)
358
+
in
359
+
Option.iter Eio.Flow.close some_write;
360
+
loop ctx job (pgid, some_read) rest)))
361
+
| CompoundCommand (c, rdrs) :: rest ->
360
362
let _rdrs =
361
363
List.map (handle_one_redirection ~sw:pipeline_switch ctx) rdrs
362
364
in
363
365
(* TODO: No way this is right *)
364
-
(Exit.value @@ handle_compound_command ctx c, job)
365
-
| v :: _ ->
366
-
Fmt.epr "TODO: %a" Yojson.Safe.pp (Ast.command_to_yojson v);
367
-
failwith "Err"
366
+
let ctx = handle_compound_command ctx c in
367
+
loop (Exit.value ctx) job (pgid, None) rest
368
+
| FunctionDefinition (name, (body, _rdrs)) :: rest ->
369
+
let ctx = { ctx with functions = (name, body) :: ctx.functions } in
370
+
loop ctx job (pgid, None) rest
368
371
| [] -> (ctx, job)
369
372
in
370
373
(* HACK: when running the pipeline, we need a process group to
···
393
396
Exit.zero { ctx with background_jobs = job :: ctx.background_jobs }
394
397
end
395
398
396
-
and expand_cst (ctx : ctx) cst =
399
+
and expand_cst (ctx : ctx) cst : ctx * Ast.word_cst =
397
400
let cst = tilde_expansion ctx cst in
398
401
let _, o = parameter_expansion' ctx in
399
402
(ctx, o cst)
···
495
498
match v with
496
499
| Ast.ForClause fc -> handle_for_clause ctx fc
497
500
| Ast.IfClause if_ -> handle_if_clause ctx if_
501
+
| Ast.BraceGroup (term, sep) -> exec ctx (term, Some sep)
498
502
| _ as c ->
499
503
Fmt.epr "Compound command not supported: %a\n%!" yojson_pp
500
504
(Ast.compound_command_to_yojson c);
501
505
exit 127
506
+
507
+
and handle_function_application (ctx : ctx) ~name argv : ctx Exit.t option =
508
+
match List.assoc_opt name ctx.functions with
509
+
| None -> None
510
+
| Some commands ->
511
+
let ctx = { ctx with argv = Array.of_list argv } in
512
+
Option.some @@ (handle_compound_command ctx commands >|= fun _ -> ctx)
502
513
503
514
and needs_subshelling = function
504
515
| [] -> false
+2
-2
src/lib/sast.ml
+2
-2
src/lib/sast.ml
···
67
67
68
68
and while_clause = While of compound_list * do_group
69
69
and until_clause = Until of compound_list * do_group
70
-
and function_definition = Function_definition of string * function_body
71
-
and function_body = Function_body of compound_command * redirects
70
+
and function_definition = string * function_body
71
+
and function_body = compound_command * redirects
72
72
and brace_group = compound_list
73
73
and do_group = compound_list
74
74
+18
test/functions.t
+18
test/functions.t
···
1
1
Testing functions and position arguments.
2
2
3
+
First is simply that the original positional arguments are preserved.
4
+
3
5
$ cat > test.sh << EOF
4
6
> echo "\$1 from \$0"
5
7
> EOF
···
9
11
$ msh test.sh hello
10
12
hello from test.sh
11
13
14
+
Next, do they work inside function definitions!
15
+
16
+
$ cat > test.sh << EOF
17
+
> shout () {
18
+
> echo \$0
19
+
> echo \$1 | tr a-z A-Z
20
+
> }
21
+
> shout "hi there"
22
+
> EOF
23
+
24
+
$ sh test.sh
25
+
test.sh
26
+
HI THERE
27
+
$ msh test.sh
28
+
test.sh
29
+
HI THERE
+6
-3
test/simple.t
+6
-3
test/simple.t
···
64
64
$ msh -c "lssssss"
65
65
msh: command not found: lssssss
66
66
[127]
67
-
$ sh -c "lssssss | echo 'all good'"
67
+
$ sh -c "lssssss 2>&1 > /dev/null | echo 'all good'"
68
68
all good
69
-
sh: line 1: lssssss: command not found
70
-
$ msh -c "lssssss | echo 'all good'"
69
+
70
+
TODO: We need to also redirect error messages from the shell,
71
+
for example the command not being found here :/
72
+
73
+
$ msh -c "lssssss 2>&1 > /dev/null | echo 'all good'"
71
74
msh: command not found: lssssss
72
75
all good
73
76