Shells in OCaml
Debug logging
Add basic support for debug logging
+104
-6
+1
dune-project
+1
dune-project
+1
merry.opam
+1
merry.opam
+9
-1
src/bin/dune
+9
-1
src/bin/dune
+13
-1
src/bin/main.ml
+13
-1
src/bin/main.ml
···
1
-
(* A shell... one day *)
2
1
module C = Merry.Eval.Make (Merry_posix.State) (Merry_posix.Exec)
3
2
4
3
module I =
···
53
52
in
54
53
Arg.(value & flag & info [ "d"; "D"; "dump" ] ~doc)
55
54
55
+
let setup_log style_renderer level =
56
+
Fmt_tty.setup_std_outputs ?style_renderer ();
57
+
Logs.set_level level;
58
+
Logs.Src.set_level Merry.Debug.src level;
59
+
Logs.set_reporter (Logs_fmt.reporter ());
60
+
()
61
+
62
+
let setup_log =
63
+
let docs = Manpage.s_common_options in
64
+
Term.(
65
+
const setup_log $ Fmt_cli.style_renderer ~docs () $ Logs_cli.level ~docs ())
66
+
56
67
let rest = Arg.(value & pos_all string [] & info [])
57
68
58
69
let cmd env =
···
76
87
Cmd.make (Cmd.info "msh" ~version:"v0.0.1" ~doc ~man)
77
88
@@
78
89
let+ command_flag = command_flag
90
+
and+ () = setup_log
79
91
and+ dump = dump
80
92
and+ file = file
81
93
and+ rest = rest in
+40
src/lib/built_ins.ml
+40
src/lib/built_ins.ml
···
91
91
| Eval of string list
92
92
| Echo of string list
93
93
| Trap of trap * [ `Signal of Eunix.Signals.t | `Exit ] list
94
+
| Return of int
95
+
96
+
let pp_args = Fmt.(list ~sep:(Fmt.any " ") string)
97
+
98
+
let to_string = function
99
+
| Cd { path = None } -> "cd"
100
+
| Cd { path = Some path } -> Fmt.str "cd %s" path
101
+
| Pwd -> "pwd"
102
+
| Exit n -> Fmt.str "exit %i" n
103
+
| Wait n -> Fmt.str "wait %i" n
104
+
| Return n -> Fmt.str "return %i" n
105
+
| Dot s -> Fmt.str "source %s" s
106
+
| Unset (`Variables vs) -> Fmt.str "unset %a" pp_args vs
107
+
| Unset (`Functions vs) -> Fmt.str "unset %a" pp_args vs
108
+
| Hash _ -> "hash"
109
+
| Command { args; _ } -> Fmt.str "command %a" pp_args args
110
+
| Alias -> "alias"
111
+
| Unalias -> "unalias"
112
+
| Eval s -> Fmt.str "eval %a" pp_args s
113
+
| Echo s -> Fmt.str "echo %a" pp_args s
114
+
| Trap _ -> "trap"
115
+
| Set _ -> "set"
94
116
95
117
(* Change Directory *)
96
118
module Cd = struct
···
407
429
let name = "dot"
408
430
end)
409
431
432
+
module Return = struct
433
+
open Cmdliner
434
+
435
+
let exit_code =
436
+
let doc = "Exit code." in
437
+
Arg.(value & pos 0 int 0 & info [] ~docv:"EXIT_CODE" ~doc)
438
+
439
+
let t =
440
+
let make_return n = Return n in
441
+
let term = Term.(const make_return $ exit_code) in
442
+
let info =
443
+
let doc = "Return from a function or exit code." in
444
+
Cmd.info "return" ~doc
445
+
in
446
+
Cmd.v info term
447
+
end
448
+
410
449
let of_args (w : string list) =
411
450
let open Cmdliner in
412
451
let exec_cmd cmd v =
···
433
472
| "eval" :: _ as cmd -> exec_cmd cmd Eval.t
434
473
| "echo" :: _ as cmd -> exec_cmd cmd Echo.t
435
474
| "trap" :: _ as cmd -> exec_cmd cmd Trap.t
475
+
| "return" :: _ as cmd -> exec_cmd cmd Return.t
436
476
| _ -> None
+4
src/lib/built_ins.mli
+4
src/lib/built_ins.mli
···
50
50
| Eval of string list
51
51
| Echo of string list
52
52
| Trap of trap * [ `Signal of Eunix.Signals.t | `Exit ] list
53
+
| Return of int
54
+
55
+
val to_string : t -> string
56
+
(** Serialises a built-in to a string *)
53
57
54
58
val of_args : string list -> (t, string) result option
55
59
(** Parses a command-line to the built-ins, errors are returned if parsing. *)
+3
src/lib/debug.ml
+3
src/lib/debug.ml
+1
src/lib/dune
+1
src/lib/dune
+9
-4
src/lib/eval.ml
+9
-4
src/lib/eval.ml
···
264
264
stdout);
265
265
(ctx, Error (127, `Not_found))
266
266
| _, (ctx, Some full_path) ->
267
+
Debug.Log.debug (fun f ->
268
+
f "executing %a" Fmt.(list string) (executable :: args));
267
269
( ctx,
268
270
E.exec ctx.executor ~delay_reap:(fst reap) ~fds ?stdin ~stdout
269
271
~pgid ~mode ~cwd:(cwd_of_ctx ctx)
···
287
289
let loop = loop pipeline_switch in
288
290
match c with
289
291
| Ast.SimpleCommand (Prefixed (prefix, None, _suffix)) :: rest ->
292
+
Debug.Log.debug (fun f ->
293
+
f "assignment-only: %a" yojson_pp
294
+
(Ast.cmd_prefix_to_yojson prefix));
290
295
let ctx = collect_assignments ctx prefix in
291
296
let job = handle_job job (`Built_in (Exit.ignore ctx)) in
292
297
loop (Exit.value ctx) job stdout_of_previous rest
···
359
364
(true, args, print_command)
360
365
| _ -> (false, [], false)
361
366
in
362
-
(* We handle the [export] built_in explicitly as we need access to the
363
-
raw CST *)
367
+
(* We handle the [export] built_in explicitly as we
368
+
need access to the raw CST *)
364
369
match executable with
365
370
| "export" ->
366
371
let updated =
···
1135
1140
| Exit.Zero ctx -> (
1136
1141
let ctx, cst = word_expansion ctx wc in
1137
1142
let cst = Ast.Fragment.handle_joins cst in
1138
-
(* Fmt.pr "Expanding: %a\n%!" Fmt.(list Ast.Fragment.pp) cst; *)
1139
1143
match ctx with
1140
1144
| Exit.Nonzero _ as ctx -> (ctx, acc)
1141
1145
| Exit.Zero _ as ctx -> (ctx, acc @ cst))))
1142
1146
(Exit.zero ctx, [])
1143
1147
swc
1144
1148
in
1145
-
(* Fmt.pr "Arguments: %a\n%!" Fmt.(list Ast.Fragment.pp) fs; *)
1146
1149
(ctx, List.map Ast.Fragment.to_string fs)
1147
1150
1148
1151
and handle_built_in ~rdrs ~(stdout : Eio_unix.sink_ty Eio.Flow.sink)
1149
1152
(ctx : ctx) v =
1150
1153
let rdrs = ctx.rdrs @ rdrs in
1154
+
Debug.Log.debug (fun f -> f "built-in: %s" (Built_ins.to_string v));
1151
1155
Eunix.with_redirections rdrs @@ fun () ->
1152
1156
match v with
1153
1157
| Built_ins.Cd { path } ->
···
1181
1185
{ Exit.default_should_exit with interactive = `Yes }
1182
1186
in
1183
1187
Exit.nonzero ~should_exit ctx n
1188
+
| Return n -> Exit.nonzero ctx n
1184
1189
| Set { update; print_options } ->
1185
1190
let v =
1186
1191
Exit.zero
+1
src/lib/merry.ml
+1
src/lib/merry.ml
+1
src/lib/merry.mli
+1
src/lib/merry.mli
+21
test/built_ins.t
+21
test/built_ins.t
···
269
269
$ msh test.sh
270
270
Running program...
271
271
Always...
272
+
273
+
11. Return
274
+
275
+
$ cat > test.sh << EOF
276
+
> foo () {
277
+
> echo "hello"
278
+
> return 2
279
+
> echo "world"
280
+
> }
281
+
> bar () {
282
+
> return 0
283
+
> echo "nope"
284
+
> }
285
+
> foo
286
+
> bar
287
+
> EOF
288
+
289
+
$ sh test.sh
290
+
hello
291
+
$ msh test.sh
292
+
hello