Shells in OCaml
3
fork

Configure Feed

Select the types of activity you want to include in your feed.

Fragment mangling

There has to be a better way of dealing with --key='value'

+84 -54
+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
··· 36 36 val make : 37 37 ?splittable:bool -> 38 38 ?globbable:bool -> 39 + ?tilde_expansion:bool -> 39 40 ?join:[ `No | `With_next | `With_previous ] -> 40 41 string -> 41 42 fragment
+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
··· 48 48 49 49 (** {2 Private} *) 50 50 51 - val word_expansion : ctx -> Ast.word_cst -> ctx Exit.t * Ast.fragment list 51 + val word_expansion : ctx -> Ast.word_cst -> ctx Exit.t * Ast.fragments list 52 52 (* Mostly for testing purposes, this exposes the logic for expanding words. *) 53 53 end
+1
src/lib/sast.ml
··· 130 130 txt : string; 131 131 splittable : bool; 132 132 globbable : bool; 133 + tilde_expansion : bool; 133 134 join : [ `No | `With_previous | `With_next ]; (* Used for "args: [$@]" *) 134 135 } 135 136 (** Post expansion representation of strings ready for possible field splitting
+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 () =