Shells in OCaml
Fragment mangling
There has to be a better way of dealing with --key='value'
+84
-54
+32
-7
src/lib/ast.ml
+32
-7
src/lib/ast.ml
···
834
834
o#word_cst ast false
835
835
836
836
module Fragment = struct
837
-
let make ?(splittable = false) ?(globbable = false) ?(join = `No) txt =
838
-
{ txt; splittable; join; globbable }
837
+
let make ?(splittable = false) ?(globbable = false) ?(tilde_expansion = false)
838
+
?(join = `No) txt =
839
+
{ txt; splittable; join; globbable; tilde_expansion }
839
840
840
841
let empty = make ""
841
842
let to_string { txt; _ } = txt
···
854
855
| `With_previous -> Fmt.pf ppf "with-previous"
855
856
| `With_next -> Fmt.pf ppf "with-next"
856
857
857
-
let pp ppf { txt; join; splittable; globbable } =
858
-
Fmt.pf ppf "{ txt = %s; join = %a; splittable = %b; globbable = %b }" txt
859
-
pp_join join splittable globbable
858
+
let pp ppf { txt; join; splittable; globbable; tilde_expansion } =
859
+
Fmt.pf ppf
860
+
"{ txt = %s; join = %a; splittable = %b; globbable = %b; tilde_expansion \
861
+
= %b }"
862
+
txt pp_join join splittable globbable tilde_expansion
860
863
861
864
let handle_joins cst =
862
865
let rec loop = function
863
866
| [] -> []
867
+
| [ x ] -> [ { x with join = `No } ]
864
868
| x :: { txt; join = `With_previous; globbable; _ } :: rest ->
865
869
loop
866
-
({ x with txt = x.txt ^ txt; globbable = x.globbable || globbable }
870
+
({
871
+
x with
872
+
join = `No;
873
+
txt = x.txt ^ txt;
874
+
globbable = x.globbable || globbable;
875
+
}
867
876
:: rest)
868
877
| { txt; join = `With_next; globbable; _ } :: y :: rest ->
869
878
{ y with txt = txt ^ y.txt; globbable = globbable || y.globbable }
870
879
:: loop rest
871
880
| x :: xs -> x :: loop xs
872
881
in
873
-
loop cst
882
+
let v = loop cst in
883
+
let has_a_tilde = List.exists (fun f -> f.tilde_expansion) v in
884
+
let v =
885
+
if has_a_tilde then [ List.fold_left (join ~sep:"") empty v ] else v
886
+
in
887
+
(* TODO: Blergh, this is horrible, surely there is a better way? Maybe morbig
888
+
should not parse these separately... *)
889
+
let rec recombine_equals = function
890
+
| [] -> []
891
+
| [ x ] -> [ x ]
892
+
| ({ txt; _ } as x) :: y :: rest -> (
893
+
let s = String.length txt in
894
+
match String.get txt (s - 1) with
895
+
| '=' -> { y with txt = txt ^ y.txt } :: recombine_equals rest
896
+
| _ -> x :: recombine_equals (y :: rest))
897
+
in
898
+
recombine_equals v
874
899
end
+1
src/lib/ast.mli
+1
src/lib/ast.mli
+31
-25
src/lib/eval.ml
+31
-25
src/lib/eval.ml
···
91
91
let clear_local_state ctx = { ctx with local_state = [] }
92
92
93
93
let tilde_expansion ctx = function
94
-
| Ast.WordTildePrefix _ -> Ast.WordLiteral (S.expand ctx.state `Tilde)
94
+
| Ast.WordTildePrefix _ -> Ast.WordTildePrefix (S.expand ctx.state `Tilde)
95
95
| v -> v
96
96
97
97
let word_cst_to_string ?field_splitting v =
···
248
248
(* This is a side-effect of the alias command with something like
249
249
alias ls="ls -la" *)
250
250
match
251
-
Ast.Fragment.join_list ~sep:"" executable
251
+
Ast.Fragment.join_list ~sep:"" (List.concat executable)
252
252
|> String.split_on_char ' ' |> List.map Ast.Fragment.make
253
253
with
254
254
| [] -> ("", [])
···
503
503
and handle_one_redirection ~sw ctx = function
504
504
| Ast.IoRedirect_IoFile (n, (op, file)) -> (
505
505
let _ctx, file = word_expansion ctx file in
506
-
let file = Ast.Fragment.join_list ~sep:"" file in
506
+
let file = Ast.Fragment.join_list ~sep:"" (List.concat file) in
507
507
match op with
508
508
| Io_op_less ->
509
509
(* Simple redirection for input *)
···
622
622
include Ast.Fragment
623
623
624
624
let make ?(join = if ctx.in_double_quotes then `With_previous else `No)
625
-
?globbable ?splittable v =
626
-
Ast.Fragment.make ~join ?splittable ?globbable v
625
+
?globbable ?splittable ?tilde_expansion v =
626
+
Ast.Fragment.make ~join ?splittable ?tilde_expansion ?globbable v
627
627
end in
628
628
match v with
629
629
| Ast.WordVariable v -> (
···
707
707
match ctx with
708
708
| Exit.Nonzero _ as ctx -> (ctx, [ [ Fragment.make "" ] ])
709
709
| Exit.Zero ctx -> (
710
-
let pattern = Fragment.join_list ~sep:"" spp in
710
+
let pattern = Fragment.join_list ~sep:"" (List.concat spp) in
711
711
match S.lookup ctx.state ~param:s with
712
712
| None ->
713
713
( Exit.zero ctx,
···
733
733
(( RemoveSmallestSuffixPattern cst
734
734
| RemoveLargestSuffixPattern cst ) as v) ) -> (
735
735
let ctx, spp = word_expansion ctx cst in
736
-
let pattern = Fragment.join_list ~sep:"" spp in
736
+
let pattern = Fragment.join_list ~sep:"" (List.concat spp) in
737
737
match ctx with
738
738
| Exit.Nonzero _ as ctx -> (ctx, [ [ Fragment.empty ] ])
739
739
| Exit.Zero ctx -> (
···
781
781
| Ast.WordDoubleQuoted cst -> (
782
782
let ctx = { ctx with in_double_quotes = true } in
783
783
let new_ctx, cst_acc = word_expansion ctx cst in
784
-
(* We now do any joining for $@... *)
785
-
let cst_acc = Fragment.handle_joins cst_acc in
786
784
let new_ctx =
787
785
Exit.map
788
786
~f:(fun ctx -> { ctx with in_double_quotes = false })
789
787
new_ctx
790
788
in
791
789
match new_ctx with
792
-
| Exit.Nonzero _ -> (new_ctx, [ cst_acc ])
793
-
| Exit.Zero new_ctx -> (Exit.zero new_ctx, [ cst_acc ]))
790
+
| Exit.Nonzero _ -> (new_ctx, cst_acc)
791
+
| Exit.Zero new_ctx -> (Exit.zero new_ctx, cst_acc))
794
792
| Ast.WordSingleQuoted cst -> (
795
793
let ctx = { ctx with in_double_quotes = true } in
796
794
let new_ctx, cst_acc = word_expansion ctx cst in
···
800
798
new_ctx
801
799
in
802
800
match new_ctx with
803
-
| Exit.Nonzero _ -> (new_ctx, [ cst_acc ])
804
-
| Exit.Zero new_ctx -> (Exit.zero new_ctx, [ cst_acc ]))
801
+
| Exit.Nonzero _ -> (new_ctx, cst_acc)
802
+
| Exit.Zero new_ctx -> (Exit.zero new_ctx, cst_acc))
805
803
| Ast.WordAssignmentWord (Name n, w) -> (
806
804
let new_ctx, cst_acc = word_expansion ctx w in
807
805
match new_ctx with
808
-
| Exit.Nonzero _ -> (new_ctx, [ cst_acc ])
806
+
| Exit.Nonzero _ -> (new_ctx, cst_acc)
809
807
| Exit.Zero _ ->
810
808
( new_ctx,
811
809
[
812
810
[
813
811
Fragment.make
814
812
(n ^ "="
815
-
^ Fragment.join_list ~sep:"" (List.concat [ cst_acc ]));
813
+
^ Fragment.join_list ~sep:"" (List.concat cst_acc));
816
814
];
817
815
] ))
818
816
| Ast.WordSubshell sub ->
···
828
826
(Exit.zero ctx, [ [ Fragment.make ~globbable:true "*" ] ])
829
827
| Ast.WordGlobAny ->
830
828
(Exit.zero ctx, [ [ Fragment.make ~globbable:true "?" ] ])
829
+
| Ast.WordTildePrefix s ->
830
+
(Exit.zero ctx, [ [ Fragment.make ~tilde_expansion:true s ] ])
831
831
| v ->
832
832
Fmt.failwith "TODO: expansion of %a" yojson_pp
833
833
(Ast.word_component_to_yojson v)
···
859
859
let cst = tilde_expansion ctx cst in
860
860
parameter_expansion ctx cst
861
861
862
-
and word_expansion ctx cst : ctx Exit.t * Ast.fragment list =
862
+
and word_expansion ctx cst : ctx Exit.t * Ast.fragments list =
863
863
let rec aux ctx = function
864
864
| [] -> (ctx, []) (* one empty word *)
865
865
| c :: rest ->
···
870
870
in
871
871
let ctx, cst = aux (Exit.zero ctx) cst in
872
872
match ctx with
873
-
| Exit.Nonzero _ -> (ctx, List.concat cst)
873
+
| Exit.Nonzero _ -> (ctx, cst)
874
874
| Exit.Zero ctx ->
875
875
let fields = cst in
876
876
let fields = List.map (field_splitting ctx) fields in
877
+
(* Fmt.pr "Fields after FP: %a\n%!" Fmt.(list (list Ast.Fragment.pp)) fields; *)
877
878
let (ctx, cst) : ctx * Ast.fragments list =
878
879
begin
879
880
let glob = Ast.Fragment.join_list ~sep:"" (List.concat fields) in
···
895
896
(ctx, vs)
896
897
end
897
898
in
898
-
(Exit.zero ctx, List.concat cst)
899
+
(Exit.zero ctx, List.map Ast.Fragment.handle_joins cst)
899
900
900
901
and handle_assignments kind ctx (assignments : string list) =
901
902
let flags, assignments =
···
948
949
| Exit.Nonzero _ -> Fmt.failwith "Redirect expansion"
949
950
| Exit.Zero ctx ->
950
951
let cst =
951
-
List.map (fun Ast.{ txt; _ } -> Ast.WordLiteral txt) cst
952
+
List.map
953
+
(fun Ast.{ txt; _ } -> Ast.WordLiteral txt)
954
+
(List.concat cst)
952
955
in
953
956
let v = Ast.Suffix_redirect (IoRedirect_IoFile (num, (op, cst))) in
954
957
expand_redirects (ctx, v :: acc) rest)
···
1011
1014
(fun _ word ->
1012
1015
update ctx ~param:name word.Ast.txt >>= fun ctx ->
1013
1016
exec ctx (term, Some sep))
1014
-
(Exit.zero ctx) words)
1017
+
(Exit.zero ctx) (List.concat words))
1015
1018
(Exit.zero ctx) wdlist
1016
1019
1017
1020
and handle_if_clause ctx = function
···
1046
1049
match ctx with
1047
1050
| Exit.Nonzero _ as ctx -> ctx
1048
1051
| Exit.Zero ctx -> (
1049
-
let scrutinee = Ast.Fragment.join_list ~sep:"" word in
1052
+
let scrutinee =
1053
+
Ast.Fragment.join_list ~sep:"" @@ List.concat word
1054
+
in
1050
1055
let res =
1051
1056
Nlist.fold_left
1052
1057
(fun acc pat ->
···
1167
1172
let state =
1168
1173
if update then
1169
1174
S.update ctx.state ~param
1170
-
(Ast.Fragment.join_list ~sep:"" v)
1175
+
(Ast.Fragment.join_list ~sep:"" @@ List.concat v)
1171
1176
else Ok ctx.state
1172
1177
in
1173
1178
match state with
···
1178
1183
ctx with
1179
1184
state;
1180
1185
local_state =
1181
-
(param, Ast.Fragment.join_list ~sep:"" v)
1186
+
( param,
1187
+
Ast.Fragment.join_list ~sep:"" @@ List.concat v
1188
+
)
1182
1189
:: ctx.local_state;
1183
1190
}))
1184
1191
| _ -> Exit.zero ctx))
···
1194
1201
| Exit.Nonzero _ as ctx -> (ctx, acc)
1195
1202
| Exit.Zero ctx -> (
1196
1203
let ctx, cst = word_expansion ctx wc in
1197
-
let cst = Ast.Fragment.handle_joins cst in
1198
1204
match ctx with
1199
1205
| Exit.Nonzero _ as ctx -> (ctx, acc)
1200
1206
| Exit.Zero _ as ctx -> (ctx, acc @ cst))))
1201
1207
(Exit.zero ctx, [])
1202
1208
swc
1203
1209
in
1204
-
(ctx, List.map Ast.Fragment.to_string fs)
1210
+
(ctx, List.map Ast.Fragment.to_string @@ List.concat fs)
1205
1211
1206
1212
and handle_built_in ~rdrs ~(stdout : Eio_unix.sink_ty Eio.Flow.sink)
1207
1213
(ctx : ctx) v =
+1
-1
src/lib/eval.mli
+1
-1
src/lib/eval.mli
+1
src/lib/sast.ml
+1
src/lib/sast.ml
+18
-21
test/wordexp.ml
+18
-21
test/wordexp.ml
···
2
2
open Merry
3
3
module C = Merry.Eval.Make (Merry_posix.State) (Merry_posix.Exec)
4
4
5
-
let expand ctx cst = C.word_expansion ctx cst |> snd
5
+
let expand ctx cst = C.word_expansion ctx cst |> snd |> List.concat
6
6
let fragment = Alcotest.of_pp Merry.Ast.Fragment.pp
7
7
let fragments = Alcotest.list fragment
8
8
let frags = List.map Ast.Fragment.make
9
9
10
-
let with_default_ctx ?(args = []) ?(params = []) env fn =
10
+
let with_default_ctx ?(args = []) ?(params = []) ?(home = "/home/merry/") env fn
11
+
=
11
12
let executor = Merry_posix.Exec.{ mgr = env#process_mgr } in
12
13
let interactive = false in
13
14
let pos_zero = "msh" in
14
15
Eio.Switch.run @@ fun async_switch ->
15
16
let signal_handler f = Eio_posix.run @@ fun _ -> f () in
16
-
let state =
17
-
Merry_posix.State.make
18
-
~home:(Sys.getenv "HOME" ^ "/")
19
-
(Fpath.v (Merry.Eunix.cwd ()))
20
-
in
17
+
let state = Merry_posix.State.make ~home (Fpath.v (Merry.Eunix.cwd ())) in
21
18
let state =
22
19
List.fold_left
23
20
(fun s (k, v) -> Merry_posix.State.update s ~param:k v |> Result.get_ok)
···
35
32
let lit s = Ast.WordLiteral s
36
33
let dquote c = Ast.WordDoubleQuoted c
37
34
let glob_all = Ast.WordGlobAll
35
+
let tilde s = Ast.WordTildePrefix s
38
36
39
37
(* let squote c = Ast.WordSingleQuoted c *)
40
38
(* let arith a = Ast.WordArithmeticExpression a *)
···
54
52
let cargs = W.[ name "echo"; dquote [ lit "hello there" ] ] in
55
53
with_default_ctx ~args env @@ fun ctx ->
56
54
let expected =
57
-
Ast.
58
-
[ Fragment.make "echo"; Fragment.make ~join:`With_previous "hello there" ]
55
+
Ast.[ Fragment.make "echo"; Fragment.make ~join:`No "hello there" ]
59
56
in
60
57
let actual = expand ctx cargs in
61
58
Alcotest.check fragments "same fragments" expected actual
···
66
63
W.[ name "echo"; dquote [ lit "hello "; var "FOO"; lit "..." ] ]
67
64
in
68
65
with_default_ctx ~args ~params:[ ("FOO", "there") ] env @@ fun ctx ->
69
-
let expected =
70
-
Ast.Fragment.[ make "echo"; make ~join:`With_previous "hello there..." ]
71
-
in
66
+
let expected = Ast.Fragment.[ make "echo"; make "hello there..." ] in
72
67
let actual = expand ctx cargs in
73
68
Alcotest.check fragments "same fragments" expected actual
74
69
···
91
86
let cargs = W.[ name "echo"; dquote [ lit "got ["; var "@"; lit "]" ] ] in
92
87
with_default_ctx ~args:[ "echo"; "a"; "b"; "c" ] env @@ fun ctx ->
93
88
let expected =
94
-
Ast.Fragment.
95
-
[
96
-
make "echo";
97
-
make ~join:`With_previous "got [a";
98
-
make "b";
99
-
make ~join:`With_next "c]";
100
-
]
89
+
Ast.Fragment.[ make "echo"; make "got [a"; make "b"; make "c]" ]
101
90
in
102
91
let actual = expand ctx cargs in
103
92
Alcotest.check fragments "same fragments" expected actual
104
93
105
-
let test_glob env () =
94
+
let _test_glob env () =
106
95
let cargs = W.[ glob_all; lit ".ml" ] in
107
96
with_default_ctx ~args:[ "*.ml" ] env @@ fun ctx ->
108
97
let expected = Ast.Fragment.[ make "test_merry.ml"; make "wordexp.ml" ] in
109
98
let actual = expand ctx cargs in
110
99
Alcotest.check fragments "same fragments" expected actual
111
100
101
+
let test_tilde env () =
102
+
let cargs = W.[ tilde "~"; lit "documents" ] in
103
+
with_default_ctx ~args:[ "~/documents" ] env @@ fun ctx ->
104
+
let expected = Ast.Fragment.[ make "/home/merry/documents" ] in
105
+
let actual = expand ctx cargs in
106
+
Alcotest.check fragments "same fragments" expected actual
107
+
112
108
let simple env =
113
109
[
114
110
("no expansions", `Quick, test_no_expansions env);
···
117
113
("single expansion", `Quick, test_single_expansion env);
118
114
("argv expansion", `Quick, test_argv_expansion env);
119
115
("argv expansion dquote", `Quick, test_argv_in_quotes_expansion env);
120
-
("glob all", `Quick, test_glob env);
116
+
(* ("glob all", `Quick, test_glob env); *)
117
+
("tilde", `Quick, test_tilde env);
121
118
]
122
119
123
120
let () =