include Omake_pos.Make (struct let name = "Omake_shell" end)
(*
* Empty environment.
*)
let node_empty = Omake_node.Node.create_phony_global "interactive shell input"
(*
* The parser.
*)
let parse_string venv s =
let ast = Omake_ast_lex.parse_string s in
let _ =
if Lm_debug.debug Omake_eval.print_ast then
Lm_printf.eprintf "@[<v 3>AST:@ %a@]@." Omake_ast_print.pp_print_prog ast
in
let senv = Omake_ir_ast.penv_of_vars (Omake_eval.eval_open_file venv) venv node_empty (Omake_env.venv_include_scope venv IncludePervasives) in
let _, ir = Omake_ir_ast.compile_exp_list senv ast in
Omake_eval.postprocess_ir venv ir
let parse_ir state venv senv prompt =
let ast = Omake_ast_lex.parse_shell state prompt in
let _ =
if Lm_debug.debug Omake_eval.print_ast then
Lm_printf.eprintf "@[<v 3>AST:@ %a@]@." Omake_ast_print.pp_print_prog ast
in
let senv, ir = Omake_ir_ast.compile_exp_list senv ast in
let e =
(* We are interested in not hiding top-level values. *)
match ir.ir_exp with
SequenceExp (_, [e]) -> e
| e -> e
in
let ir = { ir with ir_exp = e } in
senv, Omake_eval.postprocess_ir venv ir
(*
* The result printer.
*)
let print_result result =
match result with
| Omake_value_type.ValNone
| ValQuote []
| ValSequence []
| ValArray []
| ValString ""
| ValWhite _
| ValClass _
| ValOther (ValExitCode 0) ->
()
| ValInt _
| ValFloat _
| ValSequence _
| ValArray _
| ValData _
| ValQuote _
| ValQuoteString _
| ValString _
| ValNode _
| ValDir _
| ValMaybeApply _
| ValVar _
| ValObject _
| ValMap _
| ValChannel _
| ValFun _
| ValFunCurry _
| ValPrim _
| ValPrimCurry _
| ValStringExp _
| ValBody _
| ValRules _
| ValOther _
| ValCases _
| ValDelayed _ ->
Lm_printf.printf "- : %a@." Omake_value_print.pp_print_value result
(*
* Load a history file when the variable changes.
*)
let load_history_file =
let existing_file = ref None in
let load venv pos =
try
let v = Omake_env.venv_find_var_exn venv Omake_var.history_file_var in
match v with
ValNone ->
()
| _ ->
let node = Omake_value.file_of_value venv pos v in
let filename = Omake_node.Node.fullname node in
if !existing_file <> Some filename then begin
Lm_readline.load filename;
existing_file := Some filename
end
with
Not_found ->
()
| _ ->
Lm_printf.eprintf "*** osh: error loading history-file@."
in
load
(*
* Set the history length when the variable changes.
*)
let set_history_length =
let existing_length = ref 0 in
let set venv pos =
try
let v = Omake_env.venv_find_var_exn venv Omake_var.history_length_var in
let i = Omake_value.int_of_value venv pos v in
if !existing_length <> i then begin
Lm_readline.set_length i;
existing_length := i
end
with
Not_found ->
()
| _ ->
Lm_printf.eprintf "*** omake: error setting history-length@."
in
set
(*
* Tell readline about the current directory.
*)
let set_current_directory venv =
let cwd = Omake_env.venv_dir venv in
Lm_readline.set_directory (Omake_node.Dir.absname cwd)
(*
* Save the history when exiting.
*)
let exit code =
Lm_readline.save ();
Pervasives.exit code
(*
* Abort if asked.
*)
let maybe_exit_on_exception pos venv =
let abort =
try Omake_value.bool_of_value venv pos (Omake_env.venv_find_var_exn venv Omake_var.exit_on_uncaught_exception_var) with
Not_found ->
false
in
if abort then
exit Omake_state.exn_error_code
(*
* The shell main loop.
*)
let rec main state senv venv result =
(* Prompt for input *)
let loc = Omake_ast_lex.current_location state in
let pos = string_pos "shell" (loc_exp_pos loc) in
let () =
(* Cleanup any jobs that have finished *)
Omake_shell_job.cleanup venv;
(* Save any static values *)
Omake_env.venv_save_static_values venv;
(* Load from the history file if the variable has changed *)
load_history_file venv pos;
(* Set the length of the history file *)
set_history_length venv pos;
(* Set the current directory *)
set_current_directory venv;
(* Install the callback for command completion *)
Omake_shell_completion.set_completion_functions venv pos loc
in
let prompt =
try
let prompt = Omake_value_type.ValStringExp (Omake_env.venv_get_env venv, ApplyString (loc, VarVirtual (loc, Omake_symbol.prompt_sym), [], [])) in
Omake_value.string_of_value venv pos prompt
with
Omake_value_type.OmakeException _
| Omake_value_type.UncaughtException _
| Omake_value_type.RaiseException _
| Unix.Unix_error _
| Sys_error _
| Failure _
| Not_found
| Omake_value_type.Return _ ->
"% "
in
(* Evaluate it *)
let senv, venv, result =
try
let senv, ir = parse_ir state venv senv prompt in
let venv, result = Omake_eval.eval_exp venv result ir.ir_exp in
senv, venv, result
with
End_of_file ->
if Omake_env.venv_defined venv Omake_var.ignoreeof_var then begin
Lm_printf.eprintf "^D@.Use \"exit\" leave osh.@.";
senv, venv, result
end
else
exit 0
| Unix.Unix_error _
| Invalid_argument _
| Sys_error _
| Failure _
| Not_found as exn ->
Lm_printf.eprintf "%a@." Omake_exn_print.pp_print_exn (Omake_value_type.UncaughtException (pos, exn));
maybe_exit_on_exception pos venv;
senv, venv, ValNone
| Omake_value_type.ExitException (_, code) ->
exit code
| exn ->
Lm_printf.eprintf "%a@." Omake_exn_print.pp_print_exn exn;
maybe_exit_on_exception pos venv;
senv, venv, ValNone
in
print_result result;
main state senv venv result
(*
* Run an interactive shell.
*)
let shell_interactive venv =
(* Interactive mode *)
Omake_shell_sys.set_interactive true;
let state = Omake_ast_lex.create_shell () in
let () =
if Sys.os_type <> "Win32" then
let _ = Sys.signal Sys.sigttou Sys.Signal_ignore in
let _ = Sys.signal Sys.sigint Sys.Signal_ignore in
let _ = Sys.signal Sys.sigquit Sys.Signal_ignore in
let _ = Sys.signal Sys.sigtstp Sys.Signal_ignore in
()
in
(* Set up the environment *)
let venv = Omake_env.venv_add_var venv Omake_var.argv_var (ValString Sys.argv.(0)) in
let venv = Omake_env.venv_add_var venv Omake_var.star_var ValNone in
let venv = Omake_env.venv_add_var venv Omake_var.file_var (ValNode node_empty) in
let senv = Omake_ir_ast.penv_of_vars (Omake_eval.eval_open_file venv) venv node_empty (Omake_env.venv_include_scope venv IncludeAll) in
main state senv venv ValNone
(*
* Non-interactive shell to run some files.
*)
let shell_script venv scriptname args =
(* Non-interactive mode *)
Omake_shell_sys.set_interactive false;
let loc = Lm_location.bogus_loc scriptname in
let pos = string_pos "shell_targets" (loc_exp_pos loc) in
let node = Omake_env.venv_intern venv PhonyProhibited scriptname in
(* Add the command line to the environment *)
let argv = scriptname :: args in
let argv_val = Omake_value_type.ValArray (List.map (fun s -> Omake_value_type.ValString s) argv) in
let venv = Omake_env.venv_add_var venv Omake_var.argv_var argv_val in
let star_val = Omake_value_type.ValArray (List.map (fun s -> Omake_value_type.ValString s) args) in
let venv = Omake_env.venv_add_var venv Omake_var.star_var star_val in
let venv, _ =
List.fold_left (fun (venv, i) s ->
let v = Omake_var.create_numeric_var i in
let venv = Omake_env.venv_add_var venv v (ValString s) in
venv, succ i) (venv, 0) argv
in
(* Evaluate the file *)
if !Omake_shell_type.debug_shell then
Lm_printf.eprintf "@[<3>shell_script (pid=%i): running script@ %a@]@." (**)
(Unix.getpid()) Omake_node.pp_print_node node;
try ignore (Omake_eval.eval_include_file venv IncludeAll pos loc node) with
End_of_file ->
if !Omake_shell_type.debug_shell then
Lm_printf.eprintf "@[<3>shell_script (pid=%i): script@ %a:@ got EOF, exiting@]@." (**)
(Unix.getpid()) Omake_node.pp_print_node node;
exit 0
| Omake_value_type.Return _
| Omake_value_type.OmakeException _
| Omake_value_type.UncaughtException _
| Omake_value_type.RaiseException _ as exn ->
if !Omake_shell_type.debug_shell then
Lm_printf.eprintf "@[<3>shell_script (pid=%i): script@ %a:@ got exception, exiting@]@." (**)
(Unix.getpid()) Omake_node.pp_print_node node;
Lm_printf.eprintf "%a@." Omake_exn_print.pp_print_exn exn;
exit Omake_state.exn_error_code
| Omake_value_type.ExitException (_, code) ->
if !Omake_shell_type.debug_shell then
Lm_printf.eprintf "@[<3>shell_script (pid=%i): script@ %a:@ got exit exception (code = %i), exiting@]@." (**)
(Unix.getpid()) Omake_node.pp_print_node node code;
exit code
| exn ->
Lm_printf.eprintf "%a@." Omake_exn_print.pp_print_exn (Omake_value_type.UncaughtException (pos, exn));
maybe_exit_on_exception pos venv
(*
* Evaluate a string.
*)
let shell_string venv s =
(* Non-interactive mode *)
Omake_shell_sys.set_interactive false;
(* Evaluate the string *)
try ignore (Omake_eval.eval_exp venv ValNone (parse_string venv s).ir_exp) with
End_of_file ->
Lm_printf.eprintf "Empty command: %s@." s;
exit 1
| Omake_value_type.Return _
| Omake_value_type.OmakeException _
| Omake_value_type.UncaughtException _
| Omake_value_type.RaiseException _ as exn ->
Lm_printf.eprintf "%a@." Omake_exn_print.pp_print_exn exn;
exit Omake_state.exn_error_code
| Omake_value_type.ExitException (_, code) ->
exit code
| exn ->
Lm_printf.eprintf "%a@." Omake_exn_print.pp_print_exn exn;
maybe_exit_on_exception (string_exp_pos "shell_string") venv
(*
* Get the initial environment.
*)
let create_venv options targets =
(* Non-interactive mode *)
Omake_shell_sys.set_interactive false;
(* Move to ~/.omake *)
let cwd = Omake_node.Dir.cwd () in
let () =
Unix.chdir (Omake_state.omake_dir ());
Omake_node.Dir.reset_cwd ()
in
(* Now start creating *)
let exec = Omake_exec.Exec.create cwd options in
let cache = Omake_cache.create () in
let venv = Omake_env.create options "." exec cache in
let venv = Omake_env.venv_chdir_tmp venv cwd in
let venv = Omake_builtin.venv_add_command_defs venv in
let venv = Omake_env.venv_add_var venv Omake_var.targets_var (ValString (String.concat " " targets)) in
let venv = Omake_builtin.venv_add_builtins venv in
let venv = Omake_builtin.venv_include_rc_file venv Omake_state.omakeinit_file in
let venv = Omake_builtin.venv_add_pervasives venv in
let venv = Omake_builtin.venv_add_command_defs venv in
let venv = Omake_builtin.venv_include_rc_file venv Omake_state.oshrc_file in
venv
(*
* Run the shell.
*)
let shell options command targets =
let options = Omake_options.set_osh_opt options in
let venv =
try create_venv options targets with
exn when not (Omake_options.opt_allow_exceptions options) ->
Lm_printf.eprintf "%a@." Omake_exn_print.pp_print_exn exn;
exit Omake_state.exn_error_code
in
match command with
Some command ->
shell_string venv command
| None ->
match targets with
[] ->
shell_interactive venv
| filename :: args ->
shell_script venv filename args