OCaml port of https://brennan.io/2015/01/16/write-a-shell-in-c

lsh.ml

open Unix

let lsh_builtins = ["cd"; "help"; "exit"]

let print_error msg =
  prerr_string "lsh: ";
  prerr_endline msg

let lsh_cd args =
  assert (args.(0) = "cd");
  if Array.length args < 2 then
    print_error "Expected argument to \"cd\""
  else
    try chdir args.(1)
    with Unix_error (e, _, _) ->
      print_error (error_message e)

let lsh_help args =
  print_endline "Stephen Brennan's LSH";
  print_endline "Type program names and arguments, and hit enter.";
  print_endline "The following are built in:";
  List.iter (Printf.printf "  %s\n") lsh_builtins;
  print_endline "Use the man command for information on other programs."

let lsh_exit args =
  raise Exit

let lsh_builtin_cmds =
  List.map2
    (fun a b -> (a, b))
    lsh_builtins
    [lsh_cd; lsh_help; lsh_exit]

let lookup cmd =
  try Some (List.assoc cmd lsh_builtin_cmds)
  with Not_found -> None

let lsh_launch args =
  match fork () with
  | 0 -> (* child process *)
    begin try execvp args.(0) args
    with Unix_error (e, _, _) ->
      print_error (error_message e)
    end;
    exit 1
  | pid -> (* parent process *)
    let wpid, _ (* status *) = wait () in
    assert (pid = wpid)

let lsh_execute args =
  if Array.length args > 0 then
    match lookup args.(0) with
    | Some builtin -> builtin args
    | None -> lsh_launch args

let lsh_read_line = read_line

let lsh_split_line = Str.split (Str.regexp "[ \t\r\n]+")

let lsh_loop () =
  try
    while true do
      print_string "> ";
      lsh_read_line ()
      |> lsh_split_line
      |> Array.of_list
      |> lsh_execute
    done
  with
  | End_of_file -> ()
  | Exit -> print_endline "Bye"

let () =
  lsh_loop ()

Related: Writing a simple *nix shell