Shells in OCaml
Lots of fixes
- Aliasing in Morbig was slightly broken and is now hackily fixed.
- Exporting of environment variables was slightly broken
- Subshell exit codes were not quite right either
+234
-70
+1
src/bin/main.ml
+1
src/bin/main.ml
+11
-3
src/lib/built_ins.ml
+11
-3
src/lib/built_ins.ml
···
46
46
| Dot of string (* a.k.a source *)
47
47
| Unset of [ `Variables of string list | `Functions of string list ]
48
48
| Hash of hash
49
-
| Command of string list
49
+
| Command of { print_command : bool; args : string list }
50
+
| Alias
51
+
| Unalias
50
52
51
53
(* Change Directory *)
52
54
module Cd = struct
···
199
201
let doc = "Arguments to command." in
200
202
Arg.(value & pos_all string [] & info [] ~docv:"ARGS" ~doc)
201
203
204
+
let print_command =
205
+
let doc = "Write a string to stdout of the command we would use." in
206
+
Arg.(value & flag & info [ "v"; "V" ] ~docv:"V" ~doc)
207
+
202
208
let t =
203
-
let make_command pos_all = Command pos_all in
204
-
let term = Term.(const make_command $ args) in
209
+
let make_command print_command args = Command { print_command; args } in
210
+
let term = Term.(const make_command $ print_command $ args) in
205
211
let info =
206
212
let doc = "Execute a simple command." in
207
213
Cmd.info "command" ~doc
···
258
264
| "unset" :: _ as cmd -> exec_cmd cmd Unset.t
259
265
| "hash" :: _ as cmd -> exec_cmd cmd Hash.t
260
266
| "command" :: _ as cmd -> exec_cmd cmd Command.t
267
+
| "alias" :: _ -> Some (Ok Alias)
268
+
| "unalias" :: _ -> Some (Ok Unalias)
261
269
| _ -> None
+3
-1
src/lib/built_ins.mli
+3
-1
src/lib/built_ins.mli
···
23
23
| Dot of string
24
24
| Unset of [ `Variables of string list | `Functions of string list ]
25
25
| Hash of hash
26
-
| Command of string list
26
+
| Command of { print_command : bool; args : string list }
27
+
| Alias
28
+
| Unalias
27
29
28
30
val of_args : string list -> (t, string) result option
29
31
(** Parses a command-line to the built-ins, errors are returned if parsing. *)
+108
-40
src/lib/eval.ml
+108
-40
src/lib/eval.ml
···
30
30
31
31
type ctx = {
32
32
interactive : bool;
33
+
subshell : bool;
33
34
state : S.t;
34
35
local_state : (string * string) list;
35
36
executor : E.t;
···
174
175
175
176
let resolve_program ?(update = true) ctx name =
176
177
let v =
177
-
if not (String.contains name '/') then
178
-
Sys.getenv_opt "PATH"
178
+
(* Fmt.epr "Resolving %s\n%!" name; *)
179
+
if not (String.contains name '/') then begin
180
+
(* Fmt.epr "not %a\n%!" Fmt.(option string) (S.lookup ctx.state ~param:"PATH" |> Option.map Ast.word_components_to_string); *)
181
+
S.lookup ctx.state ~param:"PATH"
182
+
|> Option.map Ast.word_components_to_string
179
183
|> Option.value ~default:"/bin:/usr/bin"
180
184
|> String.split_on_char ':'
181
185
|> List.find_map (fun dir ->
182
186
let p = Filename.concat dir name in
187
+
(* Fmt.epr "Does it exist %s %b\n%!" p (Sys.file_exists p); *)
183
188
if Sys.file_exists p then Some p else None)
189
+
end
184
190
else if Sys.file_exists name then Some name
185
191
else None
186
192
in
···
201
207
List.fold_left (fun acc (k, _) -> List.remove_assoc k acc) env extra
202
208
|> List.append extra
203
209
210
+
let remove_quotes s =
211
+
let s_len = String.length s in
212
+
if s.[0] = '"' && s.[s_len - 1] = '"' then String.sub s 1 (s_len - 2) else s
213
+
204
214
let rec handle_pipeline ~async initial_ctx pipeline_switch p : ctx Exit.t =
205
215
let mode = if async then Types.Async else Types.Switched pipeline_switch in
206
216
let set_last_background ~async process ctx =
···
229
239
in
230
240
let exec_process ctx job ?fds ?stdin ~stdout ~pgid executable args =
231
241
let ctx, process =
232
-
match resolve_program ctx executable with
233
-
| ctx, None ->
234
-
Fmt.epr "msh: command not found: %s\n%!" executable;
242
+
match (executable, resolve_program ctx executable) with
243
+
| _, (ctx, None) | "", (ctx, _) ->
244
+
Eunix.with_redirections
245
+
(match fds with None -> [] | Some ls -> ls)
246
+
(fun () ->
247
+
Eio.Flow.copy_string
248
+
(Fmt.str "msh: command not found: %s\n" executable)
249
+
stdout);
235
250
(ctx, Error (127, `Not_found))
236
-
| ctx, Some full_path ->
251
+
| _, (ctx, Some full_path) ->
237
252
( ctx,
238
253
E.exec ctx.executor ?fds ?stdin ~stdout ~pgid ~mode
239
254
~cwd:(cwd_of_ctx ctx)
···
265
280
| Ast.SimpleCommand (Named (executable, suffix)) :: rest -> (
266
281
let ctx, executable = expand_cst ctx executable in
267
282
let executable = handle_word_cst_subshell ctx executable in
283
+
let executable, extra_args =
284
+
(* This is a side-effect of the alias command with something like
285
+
alias ls="ls -la" *)
286
+
match executable with
287
+
| [ Ast.WordLiteral s ] as v -> (
288
+
match String.split_on_char ' ' (remove_quotes s) with
289
+
| exec :: args ->
290
+
( [ Ast.WordName exec ],
291
+
List.map
292
+
(fun w -> Ast.Suffix_word [ Ast.WordName w ])
293
+
args )
294
+
| _ -> (v, []))
295
+
| v -> (v, [])
296
+
in
268
297
let executable = Ast.word_components_to_string executable in
269
298
let ctx, suffix =
270
299
match suffix with
271
300
| None -> (ctx, [])
272
301
| Some suffix -> expand_redirects (ctx, []) suffix
273
302
in
274
-
let ctx, args = args ctx suffix in
303
+
let ctx, args = args ctx (extra_args @ suffix) in
275
304
let args_as_strings = List.map Ast.word_components_to_string args in
276
305
let some_read, some_write =
277
306
stdout_for_pipeline ~sw:pipeline_switch ctx rest
···
294
323
| Some (Error _) ->
295
324
(ctx, handle_job ~pgid job (`Built_in (Exit.nonzero () 1)))
296
325
| (None | Some (Ok (Command _))) as v -> (
297
-
let is_command =
298
-
match v with Some (Ok (Command _)) -> true | _ -> false
326
+
let is_command, command_args, print_command =
327
+
match v with
328
+
| Some (Ok (Command { print_command; args })) ->
329
+
(true, args, print_command)
330
+
| _ -> (false, [], false)
299
331
in
300
332
(* We handle the [export] built_in explicitly as we need access to the
301
333
raw CST *)
···
324
356
in
325
357
loop saved_ctx job (pgid, some_read) rest
326
358
| None -> (
327
-
let executable, args =
359
+
let exec_and_args =
328
360
if is_command then begin
329
-
match args_as_strings with
330
-
| [] -> ("", [])
331
-
| [ x ] -> (x, [])
332
-
| x :: xs -> (x, xs)
361
+
match command_args with
362
+
| [] -> assert false
363
+
| x :: xs -> (
364
+
Eunix.with_redirections rdrs @@ fun () ->
365
+
match resolve_program ~update:false ctx x with
366
+
| _, None -> Exit.nonzero ("", []) 1
367
+
| _, Some prog ->
368
+
if print_command then
369
+
Exit.zero ("echo", [ prog ])
370
+
else Exit.zero (x, xs))
333
371
end
334
-
else (executable, args_as_strings)
372
+
else Exit.zero (executable, args_as_strings)
335
373
in
336
-
match stdout_of_previous with
337
-
| None ->
338
-
let ctx, job =
339
-
exec_process ctx job ~fds:rdrs ~stdout:some_write
340
-
~pgid executable args
374
+
match exec_and_args with
375
+
| Exit.Nonzero _ as v ->
376
+
let job =
377
+
handle_job ~pgid job (`Built_in (v >|= fun _ -> ()))
341
378
in
342
-
close_stdout ~is_global some_write;
343
379
loop ctx job (pgid, some_read) rest
344
-
| Some stdout ->
345
-
let ctx, job =
346
-
exec_process ctx job ~fds:rdrs ~stdin:stdout
347
-
~stdout:some_write ~pgid executable
348
-
args_as_strings
349
-
in
350
-
close_stdout ~is_global some_write;
351
-
loop ctx job (pgid, some_read) rest)))
380
+
| Exit.Zero (executable, args) -> (
381
+
match stdout_of_previous with
382
+
| None ->
383
+
let ctx, job =
384
+
exec_process ctx job ~fds:rdrs
385
+
~stdout:some_write ~pgid executable args
386
+
in
387
+
close_stdout ~is_global some_write;
388
+
loop ctx job (pgid, some_read) rest
389
+
| Some stdout ->
390
+
let ctx, job =
391
+
exec_process ctx job ~fds:rdrs ~stdin:stdout
392
+
~stdout:some_write ~pgid executable
393
+
args_as_strings
394
+
in
395
+
close_stdout ~is_global some_write;
396
+
loop ctx job (pgid, some_read) rest))))
352
397
| Some (Ok bi) ->
353
398
let ctx = handle_built_in ~rdrs ~stdout:some_write ctx bi in
354
399
close_stdout ~is_global some_write;
···
361
406
in
362
407
(* TODO: No way this is right *)
363
408
let ctx = handle_compound_command ctx c in
409
+
let job = handle_job ~pgid job (`Built_in (ctx >|= fun _ -> ())) in
364
410
loop (Exit.value ctx) job (pgid, None) rest
365
411
| FunctionDefinition (name, (body, _rdrs)) :: rest ->
366
412
let ctx = { ctx with functions = (name, body) :: ctx.functions } in
···
512
558
))
513
559
| Ast.VariableAtom (s, UseAlternativeValue (_, alt)) -> (
514
560
match S.lookup ctx.state ~param:s with
515
-
| Some cst -> expand (cst :: acc) ctx rest
516
-
| None -> expand (alt :: acc) ctx rest)
561
+
| Some _ -> expand (alt :: acc) ctx rest
562
+
| None -> expand ([ Ast.WordEmpty ] :: acc) ctx rest)
517
563
| Ast.VariableAtom (s, AssignDefaultValues (_, value)) -> (
518
564
match S.lookup ctx.state ~param:s with
519
565
| Some cst -> expand (cst :: acc) ctx rest
···
529
575
| Ast.WordSingleQuoted cst :: rest ->
530
576
let new_ctx, cst_acc = expand [] ctx cst in
531
577
expand ([ Ast.WordSingleQuoted cst_acc ] :: acc) new_ctx rest
578
+
| Ast.WordAssignmentWord (n, w) :: rest ->
579
+
let new_ctx, cst_acc = expand [] ctx w in
580
+
expand ([ Ast.WordAssignmentWord (n, cst_acc) ] :: acc) new_ctx rest
532
581
| v :: rest -> expand ([ v ] :: acc) ctx rest
533
582
in
534
583
expand [] ctx ast
···
543
592
state = S.update ~export:true acc_ctx.state ~param v;
544
593
}
545
594
rest
546
-
| _ :: _ -> Exit.nonzero_msg acc_ctx "export weird arguments"
595
+
| Ast.WordName param :: rest -> (
596
+
match S.lookup acc_ctx.state ~param with
597
+
| Some v ->
598
+
loop
599
+
{
600
+
acc_ctx with
601
+
state = S.update ~export:true acc_ctx.state ~param v;
602
+
}
603
+
rest
604
+
| None -> loop acc_ctx rest)
605
+
| c :: _ ->
606
+
Exit.nonzero_msg acc_ctx "export weird arguments: %s\n"
607
+
(Ast.word_component_to_string c)
547
608
in
548
609
List.fold_left
549
610
(fun ctx w -> match ctx with Exit.Zero ctx -> loop ctx w | _ -> ctx)
···
593
654
f @@ handle_pipeline ~async ctx sw p
594
655
| Noand_or, Nlist.Cons ((p, next_sep), rest) ->
595
656
let f, p = pipeline p in
596
-
fold (next_sep, f (handle_pipeline ~async ctx sw p)) rest
657
+
let exit_status = f (handle_pipeline ~async ctx sw p) in
658
+
fold (next_sep, exit_status) rest
597
659
| And, Nlist.Cons ((p, next_sep), rest) -> (
598
660
match exit_so_far with
599
661
| Exit.Zero ctx ->
···
654
716
| Ast.Subshell (term, sep) ->
655
717
let saved_ctx = ctx in
656
718
let e = exec ctx (term, Some sep) in
657
-
e >|= fun _ -> saved_ctx
719
+
let v = e >|= fun _ -> saved_ctx in
720
+
v
658
721
| _ as c ->
659
722
Fmt.epr "Compound command not supported: %a\n%!" yojson_pp
660
723
(Ast.compound_command_to_yojson c);
···
682
745
let stdout = Eio.Flow.buffer_sink buf in
683
746
let r, w = Eio_unix.pipe sw in
684
747
Eio.Fiber.fork ~sw (fun () -> Eio.Flow.copy r stdout);
685
-
let subshell_ctx = { ctx with stdout = w } in
686
-
let _ = run (Exit.zero subshell_ctx) s in
748
+
let subshell_ctx = { ctx with stdout = w; subshell = true } in
749
+
let sub_ctx, _ = run (Exit.zero subshell_ctx) s in
687
750
Eio.Flow.close w;
688
-
(ctx, Buffer.contents buf)
751
+
((sub_ctx >|= fun _ -> ctx), Buffer.contents buf)
689
752
in
690
753
let rec run_subshells ~sw ran_subshell = function
691
754
| [] -> []
···
781
844
let should_exit =
782
845
{ Exit.default_should_exit with interactive = `Yes }
783
846
in
784
-
Exit.nonzero_msg ~should_exit ctx ~exit_code:n "exit"
847
+
Exit.nonzero ~should_exit ctx n
785
848
| Set { update; print_options } ->
786
849
let v =
787
850
Exit.zero
···
826
889
Eio.Flow.copy_string (Fmt.str "%a" Hash.pp ctx.hash) stdout;
827
890
Exit.zero ctx
828
891
| _ -> assert false)
892
+
| Alias | Unalias -> Exit.zero ctx (* Morbig handles this for us *)
829
893
| Command _ ->
830
894
(* Handled separately *)
831
895
assert false
···
891
955
match
892
956
( should_exit.interactive,
893
957
should_exit.non_interactive,
894
-
ctx.interactive )
958
+
ctx.subshell,
959
+
ctx.interactive,
960
+
commands )
895
961
with
896
-
| `Yes, _, true | _, `Yes, false -> Stdlib.exit exit_code
962
+
| `Yes, _, false, true, [] | _, `Yes, false, false, [] ->
963
+
if should_exit.interactive = `Yes then Fmt.epr "exit\n%!";
964
+
Stdlib.exit exit_code
897
965
| _ -> loop_commands (exit, c :: cs) commands)
898
966
| Exit.Zero _ as ctx -> loop_commands (ctx, c :: cs) commands)
899
967
in
+4
src/lib/exit.ml
+4
src/lib/exit.ml
···
53
53
let is_nonzero = function Zero _ -> false | Nonzero _ -> true
54
54
let is_zero = function Zero _ -> true | Nonzero _ -> false
55
55
56
+
let pp ppf = function
57
+
| Zero _ -> Fmt.string ppf "zero"
58
+
| Nonzero _ -> Fmt.string ppf "nonzero"
59
+
56
60
module Syntax = struct
57
61
let ( >|= ) x f = map ~f x
58
62
let ( let+ ) = ( >|= )
+13
-5
src/lib/posix/state.ml
+13
-5
src/lib/posix/state.ml
···
9
9
variables : (bool * Merry.Ast.word_cst) Variables.t;
10
10
}
11
11
12
+
let update ?(export = false) t ~param v =
13
+
let variables' = Variables.add param (export, v) t.variables in
14
+
{ t with variables = variables' }
15
+
16
+
let seed_env () =
17
+
let env = Merry.Eunix.env () in
18
+
List.fold_left
19
+
(fun vars (param, v) ->
20
+
Variables.add param (true, [ Merry.Ast.WordName v ]) vars)
21
+
Variables.empty env
22
+
12
23
let make ?(functions = []) ?(root = 0) ?(outermost = true) ?(home = "/root")
13
-
?(variables = Variables.empty) cwd =
24
+
?variables cwd =
25
+
let variables = match variables with None -> seed_env () | Some v -> v in
14
26
{ cwd; functions; root; outermost; home; variables }
15
27
16
28
let cwd t = t.cwd
17
29
let set_cwd t cwd = { t with cwd }
18
30
let expand t = function `Tilde -> t.home
19
31
let lookup t ~param = Variables.find_opt param t.variables |> Option.map snd
20
-
21
-
let update ?(export = false) t ~param v =
22
-
let variables' = Variables.add param (export, v) t.variables in
23
-
{ t with variables = variables' }
24
32
25
33
let remove ~param t =
26
34
match Variables.find_opt param t.variables with
+42
test/built_ins.t
+42
test/built_ins.t
···
174
174
out.txt
175
175
test.sh
176
176
testing
177
+
178
+
$ msh -c "command -v ls | xargs -- basename"
179
+
ls
180
+
181
+
182
+
$ sh -c "command -v skjdlksjdlkwjdlkw"
183
+
[1]
184
+
$ msh -c "command -v skjdlksjdlkwjdlkw"
185
+
[1]
186
+
187
+
8. Alias
188
+
189
+
This is mostly handled by Morbig, but we have had to do some fixes...
190
+
191
+
$ rm *.txt
192
+
$ cat > test.sh << EOF
193
+
> ls
194
+
> alias ls="ls -a"
195
+
> ls
196
+
> unalias ls
197
+
> ls
198
+
> EOF
199
+
200
+
$ sh test.sh
201
+
test.sh
202
+
testing
203
+
.
204
+
..
205
+
test.sh
206
+
testing
207
+
test.sh
208
+
testing
209
+
$ msh test.sh
210
+
test.sh
211
+
testing
212
+
.
213
+
..
214
+
test.sh
215
+
testing
216
+
test.sh
217
+
testing
218
+
+13
-1
test/simple.t
+13
-1
test/simple.t
···
65
65
$ msh -c "export FOO=bar; env | grep FOO"
66
66
FOO=bar
67
67
68
+
Trying a common pattern for path-like expansion:
69
+
70
+
$ cat > test.sh << EOF
71
+
> export TPATH=/usr/bin
72
+
> export TPATH=/bin:\$TPATH
73
+
> echo \$TPATH
74
+
> EOF
75
+
76
+
$ sh test.sh
77
+
/bin:/usr/bin
78
+
$ msh test.sh
79
+
/bin:/usr/bin
80
+
68
81
2. Pipelines with And|Or
69
82
70
83
2.1 Simple Or
···
86
99
for example the command not being found here :/
87
100
88
101
$ msh -c "lssssss 2>&1 > /dev/null | echo 'all good'"
89
-
msh: command not found: lssssss
90
102
all good
91
103
92
104
2.2 Simple And
+11
-4
vendor/morbig.0.11.0/src/aliases.ml
+11
-4
vendor/morbig.0.11.0/src/aliases.ml
···
12
12
open Parser
13
13
open Parser.MenhirInterpreter
14
14
15
+
type ctx =
16
+
| OutsideOfSimpleCommand
17
+
| ExpectingCommandName
18
+
| AfterCommandName
19
+
15
20
let perform default f =
16
21
if not (Options.disable_alias_expansion ()) then f () else default
17
22
···
164
169
if lhs production = X (N N_linebreak) || lhs production = X (N N_word) then
165
170
about_to_reduce_cmd_name (resume checkpoint)
166
171
else
167
-
lhs production = X (N N_cmd_name)
172
+
lhs production = X (N N_cmd_name)
168
173
| InputNeeded _ ->
169
174
let dummy = Lexing.dummy_pos in
170
175
let token = NAME (Name "a_word"), dummy, dummy in
···
229
234
(** [alias_substitution aliases checkpoint word] substitutes an
230
235
alias by its definition if word is not a reserved word and
231
236
if the parsing context is about to reduce a [cmd_name]. *)
232
-
let alias_substitution aliases checkpoint word =
237
+
let alias_substitution aliases checkpoint word ctx =
233
238
perform (aliases, word) @@ fun () ->
234
239
if about_to_reduce_cmd_name checkpoint
235
240
&& not (Keyword.is_reserved_word word)
236
-
then
241
+
&& (!ctx = ExpectingCommandName)
242
+
then begin
237
243
let word = substitute aliases word in
244
+
ctx := OutsideOfSimpleCommand;
238
245
only_if_end_with_whitespace word aliases CommandNameSubstituted
239
-
else
246
+
end else
240
247
if about_to_reduce_word checkpoint
241
248
&& inside_a_substitution_combo aliases.state
242
249
then
+6
-1
vendor/morbig.0.11.0/src/aliases.mli
+6
-1
vendor/morbig.0.11.0/src/aliases.mli
···
15
15
type t
16
16
type aliases = t
17
17
18
+
type ctx =
19
+
| OutsideOfSimpleCommand
20
+
| ExpectingCommandName
21
+
| AfterCommandName
22
+
18
23
(** [empty] is an empty alias table. *)
19
24
val empty : t
20
25
···
33
38
alias by its definition if [word] is not a reserved word and
34
39
if the parsing context is about to reduce a [cmd_name]. *)
35
40
val alias_substitution :
36
-
t -> 'a Parser.MenhirInterpreter.checkpoint -> string -> t * string
41
+
t -> 'a Parser.MenhirInterpreter.checkpoint -> string -> ctx ref -> t * string
+22
-15
vendor/morbig.0.11.0/src/engine.ml
+22
-15
vendor/morbig.0.11.0/src/engine.ml
···
24
24
type state = {
25
25
checkpoint : program located checkpoint;
26
26
aliases : Aliases.t;
27
+
alias_ctx : Aliases.ctx ref;
27
28
}
28
29
29
30
module type Lexer =
···
43
44
(** Parsing loop. *)
44
45
(**--------------**)
45
46
46
-
let rec parse csts { aliases; checkpoint } =
47
+
let rec parse csts { aliases; checkpoint; alias_ctx } =
47
48
match checkpoint with
48
49
(**
49
50
···
54
55
*)
55
56
| InputNeeded _parsing_state ->
56
57
let (token, ps, pe, aliases) =
57
-
Lexer.next_token { aliases; checkpoint }
58
+
Lexer.next_token { aliases; checkpoint; alias_ctx }
58
59
in
59
-
parse csts { aliases; checkpoint = offer checkpoint (token, ps, pe) }
60
+
parse csts { aliases; checkpoint = offer checkpoint (token, ps, pe); alias_ctx }
60
61
61
62
(**
62
63
···
87
88
else
88
89
cst :: csts
89
90
in
90
-
parse csts { aliases; checkpoint }
91
+
parse csts { aliases; checkpoint; alias_ctx }
91
92
end
92
93
93
94
(**
···
132
133
133
134
*)
134
135
| HandlingError _env ->
135
-
parse csts { aliases; checkpoint = resume checkpoint }
136
+
parse csts { aliases; checkpoint = resume checkpoint; alias_ctx }
136
137
137
138
(**
138
139
···
174
175
*)
175
176
| AboutToReduce (env, production) ->
176
177
let nt = nonterminal_of_production production in
178
+
let aliax_ctx =
179
+
if nt = AnyN N_simple_command then begin
180
+
alias_ctx := Aliases.ExpectingCommandName
181
+
end
182
+
in
177
183
178
184
let rec reject_cmd_words_which_are_reserved_words () =
179
185
if is_cmd () && top_is_keyword () then parse_error ()
···
191
197
on_top_symbol env { perform = interpret_alias_command }
192
198
else
193
199
let checkpoint = resume checkpoint in
194
-
parse csts { aliases; checkpoint }
200
+
parse csts { aliases; checkpoint; alias_ctx }
195
201
and interpret_alias_command: type a. a symbol * a -> _ = function
196
202
| N N_complete_command, cst ->
197
203
let aliases = Aliases.interpret aliases cst in
198
204
let checkpoint = resume checkpoint in
199
-
parse csts { aliases; checkpoint }
205
+
parse csts { aliases; checkpoint; alias_ctx }
200
206
| _ ->
201
207
assert false (* By correctness of the underlying LR automaton. *)
202
208
in
···
209
215
210
216
*)
211
217
| Shifting (_, _, _) ->
212
-
parse csts { aliases; checkpoint = resume checkpoint }
218
+
parse csts { aliases; checkpoint = resume checkpoint; alias_ctx }
213
219
214
220
and parse_error : type a. unit -> a = fun () ->
215
221
raise (Errors.DuringParsing (Lexer.current_position ()))
216
222
in
217
223
parse [] {
218
224
aliases = Aliases.empty;
219
-
checkpoint = entry_point (Lexer.current_position ())
225
+
checkpoint = entry_point (Lexer.current_position ());
226
+
alias_ctx = ref Aliases.OutsideOfSimpleCommand
220
227
}
221
228
222
229
let recognize_word_if_relevant checkpoint word =
···
276
283
let previous_token ?(n = 0) () =
277
284
ExtPervasives.list_nth_opt !tokens n
278
285
279
-
let rec next_token { aliases; checkpoint } =
286
+
let rec next_token { aliases; checkpoint; alias_ctx } =
280
287
if HDL.inside_here_document () then (
281
288
!push_pretoken (HDL.next_here_document (lexbuf ()) (current ()));
282
-
next_token { aliases; checkpoint }
289
+
next_token { aliases; checkpoint; alias_ctx }
283
290
)
284
291
else
285
292
let (pretoken, pstart, pstop) as p = !next_pretoken () in
···
320
327
rules, or applies globally.
321
328
322
329
*)
323
-
let new_aliases, w = alias_substitution aliases checkpoint w0 in
330
+
let new_aliases, w = alias_substitution aliases checkpoint w0 alias_ctx in
324
331
let word =
325
332
if w == w0 then
326
333
WORD (Word (w, List.(flatten (map parse_pattern cst))))
···
376
383
the here-document lexing mode. *)
377
384
if HDL.next_line_is_here_document () then (
378
385
HDL.start_here_document_lexing ();
379
-
next_token { aliases; checkpoint }
386
+
next_token { aliases; checkpoint; alias_ctx }
380
387
)
381
388
382
389
(** If the input is completed, [NEWLINE] is interpreted
···
408
415
pos_cnum = p.pos_cnum
409
416
}
410
417
411
-
let next_token ({ aliases; checkpoint } as state) =
418
+
let next_token ({ aliases; checkpoint; alias_ctx } as state) =
412
419
let curr_p = copy_position (lexbuf ()).Lexing.lex_curr_p in
413
-
let state' = { aliases; checkpoint } in
420
+
let state' = { aliases; checkpoint; alias_ctx } in
414
421
let (raw, _, _, aliases) as token = next_token state' in
415
422
let state = { state with aliases } in
416
423
tokens := raw :: !tokens;