+3 -1

src/lib/arith.ml

··· 32 32 | _ -> 0 33 33 in 34 34 let update state s i = 35 35 - S.update state ~param:s [ Ast.WordLiteral (string_of_int i) ] 35 35 + match S.update state ~param:s [ Ast.WordLiteral (string_of_int i) ] with 36 36 + | Ok s -> s 37 37 + | Error m -> failwith m 36 38 in 37 39 let rec calc state = function 38 40 | Int i -> (state, i)

+19

src/lib/built_ins.ml

··· 50 50 | Alias 51 51 | Unalias 52 52 | Eval of string list 53 53 + | Echo of string list 53 54 54 55 (* Change Directory *) 55 56 module Cd = struct ··· 250 251 Cmd.v info term 251 252 end 252 253 254 254 + module Echo = struct 255 255 + open Cmdliner 256 256 + 257 257 + let args = 258 258 + let doc = "The arguments to echo to standard output." in 259 259 + Arg.(value & pos_all string [] & info [] ~docv:"ARGS" ~doc) 260 260 + 261 261 + let t = 262 262 + let make_echo args = Echo args in 263 263 + let term = Term.(const make_echo $ args) in 264 264 + let info = 265 265 + let doc = "Display a line of text." in 266 266 + Cmd.info "echo" ~doc 267 267 + in 268 268 + Cmd.v info term 269 269 + end 270 270 + 253 271 module Source = Make_dot (struct 254 272 let name = "source" 255 273 end) ··· 282 300 | "alias" :: _ -> Some (Ok Alias) 283 301 | "unalias" :: _ -> Some (Ok Unalias) 284 302 | "eval" :: _ as cmd -> exec_cmd cmd Eval.t 303 303 + | "echo" :: _ as cmd -> exec_cmd cmd Echo.t 285 304 | _ -> None

+1

src/lib/built_ins.mli

··· 27 27 | Alias 28 28 | Unalias 29 29 | Eval of string list 30 30 + | Echo of string list 30 31 31 32 val of_args : string list -> (t, string) result option 32 33 (** Parses a command-line to the built-ins, errors are returned if parsing. *)

+115 -51

src/lib/eval.ml

··· 246 246 List.fold_left (fun acc (k, _) -> List.remove_assoc k acc) env extra 247 247 |> List.append extra 248 248 249 249 + let update ?export ?readonly ctx ~param v = 250 250 + match S.update ?export ?readonly ctx.state ~param v with 251 251 + | Ok state -> Exit.zero { ctx with state } 252 252 + | Error msg -> 253 253 + Fmt.epr "%s\n%!" msg; 254 254 + Exit.nonzero ctx 1 255 255 + 249 256 let remove_quotes s = 250 257 let s_len = String.length s in 251 258 if s.[0] = '"' && s.[s_len - 1] = '"' then String.sub s 1 (s_len - 2) else s ··· 313 320 match c with 314 321 | Ast.SimpleCommand (Prefixed (prefix, None, _suffix)) :: rest -> 315 322 let ctx = collect_assignments ctx prefix in 316 316 - loop ctx job stdout_of_previous rest 323 323 + let job = handle_job job (`Built_in (ctx >|= fun _ -> ())) in 324 324 + loop (Exit.value ctx) job stdout_of_previous rest 317 325 | Ast.SimpleCommand (Prefixed (prefix, Some executable, suffix)) :: rest 318 326 -> 319 327 let ctx = collect_assignments ~update:false ctx prefix in 320 320 - loop ctx job stdout_of_previous 328 328 + let job = handle_job job (`Built_in (ctx >|= fun _ -> ())) in 329 329 + loop (Exit.value ctx) job stdout_of_previous 321 330 (Ast.SimpleCommand (Named (executable, suffix)) :: rest) 322 331 | Ast.SimpleCommand (Named (executable, suffix)) :: rest -> ( 323 332 let ctx, executable = expand_cst ctx executable in ··· 377 386 raw CST *) 378 387 match executable with 379 388 | "export" -> 380 380 - let updated = handle_export ctx args in 389 389 + let updated = 390 390 + handle_export_or_readonly `Export ctx args 391 391 + in 392 392 + let job = 393 393 + handle_job job (`Built_in (updated >|= fun _ -> ())) 394 394 + in 395 395 + loop (Exit.value updated) job stdout_of_previous rest 396 396 + | "readonly" -> 397 397 + let updated = 398 398 + handle_export_or_readonly `Readonly ctx args 399 399 + in 381 400 let job = 382 401 handle_job job (`Built_in (updated >|= fun _ -> ())) 383 402 in ··· 530 549 prefix 531 550 in 532 551 let rec expand acc ctx = function 533 533 - | [] -> (ctx, List.rev acc |> List.concat) 552 552 + | [] -> (Exit.zero ctx, List.rev acc |> List.concat) 534 553 | Ast.WordVariable v :: rest -> ( 535 554 match v with 536 555 | Ast.VariableAtom ("!", NoAttribute) -> ··· 619 638 | Ast.VariableAtom (s, AssignDefaultValues (_, value)) -> ( 620 639 match S.lookup ctx.state ~param:s with 621 640 | Some cst -> expand (cst :: acc) ctx rest 622 622 - | None -> 623 623 - let state = S.update ctx.state ~param:s value in 624 624 - let new_ctx = { ctx with state } in 625 625 - expand (value :: acc) new_ctx rest) 641 641 + | None -> ( 642 642 + match S.update ctx.state ~param:s value with 643 643 + | Ok state -> 644 644 + let new_ctx = { ctx with state } in 645 645 + expand (value :: acc) new_ctx rest 646 646 + | Error m -> 647 647 + ( Exit.nonzero_msg ~exit_code:1 ctx "%s" m, 648 648 + List.rev acc |> List.concat ))) 626 649 | Ast.VariableAtom (_, IndicateErrorifNullorUnset (_, _)) -> 627 650 Fmt.failwith "TODO: Indicate Error") 628 628 - | Ast.WordDoubleQuoted cst :: rest -> 651 651 + | Ast.WordDoubleQuoted cst :: rest -> ( 629 652 let new_ctx, cst_acc = expand [] ctx cst in 630 630 - expand ([ Ast.WordDoubleQuoted cst_acc ] :: acc) new_ctx rest 631 631 - | Ast.WordSingleQuoted cst :: rest -> 653 653 + match new_ctx with 654 654 + | Exit.Nonzero _ -> (new_ctx, cst_acc) 655 655 + | Exit.Zero new_ctx -> 656 656 + expand ([ Ast.WordDoubleQuoted cst_acc ] :: acc) new_ctx rest) 657 657 + | Ast.WordSingleQuoted cst :: rest -> ( 632 658 let new_ctx, cst_acc = expand [] ctx cst in 633 633 - expand ([ Ast.WordSingleQuoted cst_acc ] :: acc) new_ctx rest 634 634 - | Ast.WordAssignmentWord (n, w) :: rest -> 659 659 + match new_ctx with 660 660 + | Exit.Nonzero _ -> (new_ctx, cst_acc) 661 661 + | Exit.Zero new_ctx -> 662 662 + expand ([ Ast.WordSingleQuoted cst_acc ] :: acc) new_ctx rest) 663 663 + | Ast.WordAssignmentWord (n, w) :: rest -> ( 635 664 let new_ctx, cst_acc = expand [] ctx w in 636 636 - expand ([ Ast.WordAssignmentWord (n, cst_acc) ] :: acc) new_ctx rest 665 665 + match new_ctx with 666 666 + | Exit.Nonzero _ -> (new_ctx, cst_acc) 667 667 + | Exit.Zero new_ctx -> 668 668 + expand 669 669 + ([ Ast.WordAssignmentWord (n, cst_acc) ] :: acc) 670 670 + new_ctx rest) 637 671 | v :: rest -> expand ([ v ] :: acc) ctx rest 638 672 in 639 673 expand [] ctx ast 640 674 641 641 - and handle_export ctx (assignments : Ast.word_cst list) = 675 675 + and handle_export_or_readonly kind ctx (assignments : Ast.word_cst list) = 676 676 + let flags, assignments = 677 677 + List.fold_left 678 678 + (fun (fs, args) -> function 679 679 + | [ Ast.WordName v ] | [ Ast.WordLiteral v ] -> ( 680 680 + match Astring.String.cut ~sep:"-" v with 681 681 + | Some ("", f) -> (f :: fs, args) 682 682 + | _ -> (fs, [ Ast.WordName v ] :: args)) 683 683 + | v -> (fs, v :: args)) 684 684 + ([], []) assignments 685 685 + in 686 686 + let update = 687 687 + match kind with 688 688 + | `Export -> update ~export:true ~readonly:false 689 689 + | `Readonly -> update ~export:false ~readonly:true 690 690 + in 642 691 let rec loop acc_ctx = function 643 692 | [] -> Exit.zero acc_ctx 644 693 | Ast.WordAssignmentWord (Name param, v) :: rest -> 645 645 - loop 646 646 - { 647 647 - acc_ctx with 648 648 - state = S.update ~export:true acc_ctx.state ~param v; 649 649 - } 650 650 - rest 694 694 + update acc_ctx ~param v >>= fun new_ctx -> loop new_ctx rest 651 695 | Ast.WordName param :: rest -> ( 652 696 match S.lookup acc_ctx.state ~param with 653 697 | Some v -> 654 654 - loop 655 655 - { 656 656 - acc_ctx with 657 657 - state = S.update ~export:true acc_ctx.state ~param v; 658 658 - } 659 659 - rest 698 698 + update acc_ctx ~param v >>= fun new_ctx -> loop new_ctx rest 660 699 | None -> loop acc_ctx rest) 661 700 | c :: _ -> 662 701 Exit.nonzero_msg acc_ctx "export weird arguments: %s\n" 663 702 (Ast.word_component_to_string c) 664 703 in 665 665 - List.fold_left 666 666 - (fun ctx w -> match ctx with Exit.Zero ctx -> loop ctx w | _ -> ctx) 667 667 - (Exit.zero ctx) assignments 704 704 + match flags with 705 705 + | [] -> 706 706 + List.fold_left 707 707 + (fun ctx w -> match ctx with Exit.Zero ctx -> loop ctx w | _ -> ctx) 708 708 + (Exit.zero ctx) assignments 709 709 + | fs -> 710 710 + if List.mem "p" fs then begin 711 711 + match kind with 712 712 + | `Readonly -> S.pp_readonly Fmt.stdout ctx.state 713 713 + | `Export -> S.pp_export Fmt.stdout ctx.state 714 714 + end; 715 715 + Exit.zero ctx 668 716 669 717 and expand_cst (ctx : ctx) cst : ctx * Ast.word_cst = 670 718 let cst = tilde_expansion ctx cst in 671 719 let ctx, cst = parameter_expansion' ctx cst in 672 672 - arithmetic_expansion ctx cst 720 720 + match ctx with 721 721 + | Exit.Nonzero { value = ctx; _ } -> (ctx, cst) 722 722 + | Exit.Zero ctx -> 723 723 + (* TODO: Propagate errors *) 724 724 + let ctx, ast = arithmetic_expansion ctx cst in 725 725 + (ctx, ast) 673 726 674 727 and expand_redirects ((ctx, acc) : ctx * Ast.cmd_suffix_item list) 675 728 (c : Ast.cmd_suffix_item list) = ··· 735 788 let wdlist = Nlist.flatten @@ Nlist.map (word_glob_expand ctx) wdlist in 736 789 Nlist.fold_left 737 790 (fun _ word -> 738 738 - let s = S.update ctx.state ~param:name word in 739 739 - let ctx = { ctx with state = s } in 740 740 - exec ctx (term, Some sep)) 791 791 + update ctx ~param:name word >>= fun ctx -> exec ctx (term, Some sep)) 741 792 (Exit.zero ctx) wdlist 742 793 743 794 and handle_if_clause ctx = function ··· 900 951 if List.exists needs_glob_expansion wc then glob_expand ctx wc 901 952 else [ handle_word_cst_subshell ctx wc ] 902 953 903 903 - and collect_assignments ?(update = true) ctx = 954 954 + and collect_assignments ?(update = true) ctx vs : ctx Exit.t = 904 955 List.fold_left 905 905 - (fun ctx -> function 906 906 - | Ast.Prefix_assignment (Name param, v) -> 907 907 - (* Expand the values *) 908 908 - let ctx, v = expand_cst ctx v in 909 909 - let v = handle_subshell ctx v in 910 910 - let state = 911 911 - if update then S.update ctx.state ~param v else ctx.state 912 912 - in 913 913 - { 914 914 - ctx with 915 915 - state; 916 916 - local_state = 917 917 - (param, Ast.word_components_to_string v) :: ctx.local_state; 918 918 - } 919 919 - | _ -> ctx) 920 920 - ctx 956 956 + (fun ctx prefix -> 957 957 + match ctx with 958 958 + | Exit.Nonzero _ -> ctx 959 959 + | Exit.Zero ctx -> ( 960 960 + match prefix with 961 961 + | Ast.Prefix_assignment (Name param, v) -> ( 962 962 + (* Expand the values *) 963 963 + let ctx, v = expand_cst ctx v in 964 964 + let v = handle_subshell ctx v in 965 965 + let state = 966 966 + if update then S.update ctx.state ~param v else Ok ctx.state 967 967 + in 968 968 + match state with 969 969 + | Error message -> Exit.nonzero ~message ctx 1 970 970 + | Ok state -> 971 971 + Exit.zero 972 972 + { 973 973 + ctx with 974 974 + state; 975 975 + local_state = 976 976 + (param, Ast.word_components_to_string v) 977 977 + :: ctx.local_state; 978 978 + }) 979 979 + | _ -> Exit.zero ctx)) 980 980 + (Exit.zero ctx) vs 921 981 922 982 and args ctx swc : ctx * Ast.word_cst list = 923 983 List.fold_left ··· 1010 1070 let ast = Ast.of_string script in 1011 1071 let ctx, _ = run (Exit.zero ctx) ast in 1012 1072 ctx 1073 1073 + | Echo args -> 1074 1074 + let str = String.concat " " args ^ "\n" in 1075 1075 + Eio.Flow.copy_string str stdout; 1076 1076 + Exit.zero ctx 1013 1077 | Command _ -> 1014 1078 (* Handled separately *) 1015 1079 assert false

+3

src/lib/exit.ml

··· 46 46 | Zero v -> Zero (f v) 47 47 | Nonzero ({ value; _ } as v) -> Nonzero { v with value = f value } 48 48 49 49 + let map_zero ~f = function Zero v -> f v | Nonzero x -> Nonzero x 50 50 + 49 51 let map' ~zero ~nonzero = function 50 52 | Zero v -> Zero (zero v) 51 53 | Nonzero v -> Nonzero { v with value = nonzero v.value } ··· 59 61 60 62 module Syntax = struct 61 63 let ( >|= ) x f = map ~f x 64 64 + let ( >>= ) x f = map_zero ~f x 62 65 let ( let+ ) = ( >|= ) 63 66 end

+46 -6

src/lib/posix/state.ml

··· 1 1 module Variables = Map.Make (String) 2 2 3 3 + type attributes = { export : bool; readonly : bool } 4 4 + 5 5 + let default_attribute = { export = false; readonly = false } 6 6 + 3 7 type t = { 4 8 cwd : Fpath.t; 5 9 functions : Merry.Function.t list; 6 10 root : int; 7 11 outermost : bool; 8 12 home : string; 9 9 - variables : (bool * Merry.Ast.word_cst) Variables.t; 13 13 + variables : (attributes * Merry.Ast.word_cst) Variables.t; 10 14 } 11 15 12 12 - let update ?(export = false) t ~param v = 13 13 - let variables' = Variables.add param (export, v) t.variables in 14 14 - { t with variables = variables' } 16 16 + let update ?(export = false) ?(readonly = false) t ~param v = 17 17 + match Variables.find_opt param t.variables with 18 18 + | Some ({ readonly = true; _ }, _) -> 19 19 + Error (Fmt.str "%s: readonly variable" param) 20 20 + | _ -> 21 21 + let attr = { export; readonly } in 22 22 + let variables' = Variables.add param (attr, v) t.variables in 23 23 + Ok { t with variables = variables' } 15 24 16 25 let seed_env () = 17 26 let env = Merry.Eunix.env () in 18 27 List.fold_left 19 28 (fun vars (param, v) -> 20 20 - Variables.add param (true, [ Merry.Ast.WordName v ]) vars) 29 29 + Variables.add param 30 30 + ({ default_attribute with export = true }, [ Merry.Ast.WordName v ]) 31 31 + vars) 21 32 Variables.empty env 22 33 23 34 let make ?(functions = []) ?(root = 0) ?(outermost = true) ?(home = "/root") ··· 37 48 38 49 let exports t = 39 50 Variables.to_list t.variables 40 40 - |> List.filter_map (function p, (true, v) -> Some (p, v) | _ -> None) 51 51 + |> List.filter_map (function 52 52 + | p, ({ export = true; _ }, v) -> Some (p, v) 53 53 + | _ -> None) 54 54 + 55 55 + let readonly t = 56 56 + Variables.to_list t.variables 57 57 + |> List.filter_map (function 58 58 + | p, ({ readonly = true; _ }, v) -> Some (p, v) 59 59 + | _ -> None) 60 60 + 61 61 + let pp_readonly fmt t = 62 62 + let rs = readonly t in 63 63 + let rs = 64 64 + List.map 65 65 + (fun (p, cst) -> 66 66 + ("readonly " ^ p, Merry.Ast.word_components_to_string cst)) 67 67 + rs 68 68 + in 69 69 + Fmt.(list ~sep:(Fmt.any "\n") (pair ~sep:(Fmt.any "=") string (quote string))) 70 70 + fmt rs 71 71 + 72 72 + let pp_export fmt t = 73 73 + let rs = exports t in 74 74 + let rs = 75 75 + List.map 76 76 + (fun (p, cst) -> ("export " ^ p, Merry.Ast.word_components_to_string cst)) 77 77 + rs 78 78 + in 79 79 + Fmt.(list ~sep:(Fmt.any "\n") (pair ~sep:(Fmt.any "=") string (quote string))) 80 80 + fmt rs 41 81 42 82 let dump ppf s = 43 83 Fmt.pf ppf "Variables:[%a]"

+12 -1

src/lib/types.ml

··· 23 23 val lookup : t -> param:string -> Ast.word_cst option 24 24 (** Parameter lookup. [None] means [unset]. *) 25 25 26 26 - val update : ?export:bool -> t -> param:string -> Ast.word_cst -> t 26 26 + val update : 27 27 + ?export:bool -> 28 28 + ?readonly:bool -> 29 29 + t -> 30 30 + param:string -> 31 31 + Ast.word_cst -> 32 32 + (t, string) result 27 33 (** Update the state with a new parameter mapping and whether or not it should 28 34 exported to the environment (default false). *) 29 35 ··· 34 40 val exports : t -> (string * Ast.word_cst) list 35 41 (** All of the variables that must be exported to the environment *) 36 42 43 43 + val readonly : t -> (string * Ast.word_cst) list 44 44 + (** All of the variables that must be exported to the environment *) 45 45 + 46 46 + val pp_readonly : t Fmt.t 47 47 + val pp_export : t Fmt.t 37 48 val dump : t Fmt.t 38 49 end 39 50

+18

test/built_ins.t

··· 221 221 test.sh 222 222 testing 223 223 224 224 + 9. Readonly 225 225 + 226 226 + $ cat > test.sh <<EOF 227 227 + > readonly test_x=foo 228 228 + > readonly test_y=bar 229 229 + > readonly -p 230 230 + > test_x=woops 231 231 + > EOF 232 232 + 233 233 + $ sh test.sh | grep test_ 234 234 + test.sh: line 4: test_x: readonly variable 235 235 + readonly test_x="foo" 236 236 + readonly test_y="bar" 237 237 + 238 238 + $ msh test.sh | grep test_ 239 239 + test_x: readonly variable 240 240 + readonly test_x="foo" 241 241 + readonly test_y="bar"