Source file ShellLua.ml

let quick_error msg =
  prerr_endline "FATAL: The `lua` subcommand failed.";
  prerr_endline (MlFront_Thunk.ThunkStrings.left_pad msg);
  exit 1

type lua_options = {
  analysis : bool;
  interactive : bool;
  valuescan : bool;
  lua_script : string option;
  lua_args : ShellCoreLua.lua_arg2 list;
}

let lua_options ~usage_msg =
  let analysis = ref false in
  let valuescan = ref false in
  let interactive = ref None in
  let lua_script = ref None in
  let lua_args = ref [ ShellCoreLua.Interpreter2 "lua" ] in
  let anon_fun s =
    match !lua_script with
    | None ->
        lua_script := Some s;
        lua_args := LuaScript2 s :: !lua_args
    | Some _ -> lua_args := Arg2 s :: !lua_args
  in
  ( [
      ( "-help",
        Arg.Unit
          (fun () ->
            print_endline usage_msg;
            exit 0),
        "" );
      ( "--help",
        Arg.Unit
          (fun () ->
            print_endline usage_msg;
            exit 0),
        "" );
      ("--analysis", Arg.Set analysis, "");
      ("--valuescan", Arg.Set valuescan, "");
      ("-i", Arg.Unit (fun () -> interactive := Some ()), "");
      ("-e", Arg.String (fun s -> lua_args := DoString2 s :: !lua_args), "");
      ( "-l",
        Arg.String
          (fun s ->
            lua_args := Require2 (ShellCoreLua.parse_modname s) :: !lua_args),
        "" );
    ],
    anon_fun,
    fun () ->
      let interactive =
        (* default is interactive if no `script` is given _and_ stdin is a terminal *)
        match (!interactive, !lua_script) with
        | Some (), _ -> true
        | _, Some _ -> false
        | None, None ->
            if Unix.isatty Unix.stdin then true
            else
              let console = MlFront_Console.Console.create_no_terminal () in
              MlFront_Console.Console.supports_virtual_terminal console
      in
      {
        analysis = !analysis;
        valuescan = !valuescan;
        interactive;
        lua_script = !lua_script;
        lua_args = List.rev !lua_args;
      } )

let rec pp_lua_stmt :
    Format.formatter -> MlFront_Thunk.ThunkLuaScript.Ast.stmt -> unit =
 fun ppf -> function
  | Stmt' (loc, stmt) ->
      Format.fprintf ppf "@[<hov 2>Stmt'(@,byte %d: %a)@]" loc pp_lua_stmt stmt
  | Assign (lvals, exps) ->
      Format.fprintf ppf "@[<hov 2>Assign(@[%a@]@ =@ @[%a@])@]"
        (Format.pp_print_list pp_lua_lval)
        lvals
        (Format.pp_print_list pp_lua_exp)
        exps
  | WhileDo (_exp, _block) -> Format.fprintf ppf "WhileDo"
  | RepeatUntil (_block, _exp) -> Format.fprintf ppf "RepeatUntil"
  | If (_exp, _block, _list, _option) -> Format.fprintf ppf "If"
  | Return _exp_list -> Format.fprintf ppf "Return"
  | Callstmt _call -> Format.fprintf ppf "Callstmt"
  | Local (_name_list, _exp_list) -> Format.fprintf ppf "Local"

and pp_lua_lval :
    Format.formatter -> MlFront_Thunk.ThunkLuaScript.Ast.lval -> unit =
 fun ppf -> function
  | Lvar name -> Format.fprintf ppf "Lvar(%s)" name
  | Lindex (_exp1, _exp2) -> Format.fprintf ppf "Lindex"

and pp_lua_exp :
    Format.formatter -> MlFront_Thunk.ThunkLuaScript.Ast.exp -> unit =
 fun ppf -> function
  | Var name -> Format.fprintf ppf "Var(%s)" name
  | Lit _value -> Format.fprintf ppf "Lit"
  | Binop (_exp1, _op, _exp2) -> Format.fprintf ppf "Binop"
  | Unop (_op, _exp) -> Format.fprintf ppf "Unop"
  | Index (_exp1, _exp2) -> Format.fprintf ppf "Index"
  | Table (exp_list, name_exp_list) ->
      Format.fprintf ppf "@[<hov 2>Table(%a;@ %a)@]"
        (Format.pp_print_list ~pp_sep:Format.pp_print_space pp_lua_exp)
        exp_list
        (Format.pp_print_list ~pp_sep:Format.pp_print_space
           (fun ppf (name, _exp) -> Format.fprintf ppf "%s = ..." name))
        name_exp_list
  | Call _call -> Format.fprintf ppf "Call"

let pp_lua_chunk :
    Format.formatter -> MlFront_Thunk.ThunkLuaScript.Ast.chunk -> unit =
 fun ppf -> function
  | Debug _ -> Format.fprintf ppf "[lua-lex] Debug()"
  | Statement stmt ->
      Format.fprintf ppf "@[<hov 2>[lua-lex] Statement(@,%a)@]" pp_lua_stmt stmt
  | Fundef (loc, _, _, _) -> Format.fprintf ppf "[lua-lex] Fundef(byte %d)" loc
  | Methdef (loc, _, _, _, _) ->
      Format.fprintf ppf "[lua-lex] Methdef(byte %d)" loc

let lua_lex map buf = MlFront_Lua.Luascanner.token buf map

(* Nanopass 3 *)
let nanopass3 args =
  List.filter_map
    (function
      | ShellCoreLua.FileWithUiRuleEmbedded2 _ | ShellCoreLua.UiRule2 _ ->
          (* no UI rules in `lua` subcommand *)
          None
      | ShellCoreLua.Interpreter2 _ | ShellCoreLua.Arg2 _ ->
          (* no Arg and Interpreter in nanopass 3 *)
          None
      | ShellCoreLua.DoString2 x -> Some (ShellCoreLua.DoString3 x)
      | ShellCoreLua.Require2 x -> Some (ShellCoreLua.Require3 x)
      | ShellCoreLua.LuaScript2 x -> Some (ShellCoreLua.LuaScript3 x))
    args

let process_lua_command ~usage_msg ~mini_usage_msg ~baseconfig ~verbosity
    ~progress ~install ~random_seed ~wait_trace_store ~nobuiltininc ~nosysinc
    ~noworkspaceinc ~sysincludedirs ~userincludedirs ~cells ~local_packages
    ~build_number ~long_ids ~import ~invalidations debugmodes module_or args =
  (* Parse *)
  let current = ref 1 in
  let speclist, anon_fun, mk_options = lua_options ~usage_msg in
  let cmdline = "dk0" :: "lua" :: args in
  (try
     Arg.parse_argv ~current (Array.of_list cmdline) speclist anon_fun
       mini_usage_msg
   with
  | Arg.Bad msg ->
      prerr_endline msg;
      exit 1
  | Arg.Help msg ->
      prerr_endline msg;
      exit 0);

  (* Consider options *)
  let options = mk_options () in

  (* Setup VALUESCAN runner *)
  let module ForAnalysis = struct
    let in_what = "in analysis"
    let command_name = "lua"
  end in
  let module ValueScanRunner =
    ShellCoreLua.MakeRunner
      (ForAnalysis)
      (MlFront_Thunk.ThunkLuaScript.IAnalyze)
  in
  ();

  (* Parse + analyze chunks if VALUESCAN *)
  let prefetch2_lua_scripts =
    if options.valuescan then
      let g_analyze = ValueScanRunner.mk () in
      let analysis =
        List.fold_left
          (fun acc -> function
            | ShellCoreLua.DoString2 s ->
                ValueScanRunner.dostring_analysis ~sourcename:"<cli>" g_analyze
                  s
                :: acc
            | Arg2 _ -> acc
            | Require2 { global_opt = _; modname; version_opt = None } ->
                Printf.eprintf
                  "[valuescan] Missing .at(version) for require(%s)\n" modname;
                acc
            | Require2 { global_opt = _; modname; version_opt = Some version }
              -> begin
                match
                  MlFront_Thunk.ThunkCommand.InternalUse.parse_moduleversion
                    (modname ^ "@" ^ version)
                with
                | Error msg ->
                    Printf.eprintf
                      "[valuescan] The version `%s` for require(%s) is not a \
                       valid semver. %s\n"
                      version modname msg;
                    acc
                | Ok modver ->
                    [
                      MlFront_Thunk.ThunkLuaTypAnalysis.StandardModuleRequireAt
                        { modver };
                    ]
                    :: acc
              end
            | LuaScript2 script ->
                ValueScanRunner.dofile_analysis g_analyze script :: acc
            | UiRule2 _ | FileWithUiRuleEmbedded2 _ ->
                (* no analysis on UI rules; `lua` subcommand does not use them anyways *)
                acc
            | Interpreter2 _ -> acc)
          [] options.lua_args
      in
      let flat_analysis = List.flatten (List.rev analysis) in
      List.filter_map
        (function
          | MlFront_Thunk.ThunkLuaTypAnalysis.StandardModuleRequireAt { modver }
            ->
              if verbosity > 0 then
                Printf.eprintf "[valuescan] Prefetching Lua module %s@%s\n"
                  (MlFront_Core.StandardModuleId.show_dot modver.id)
                  (MlFront_Thunk.ThunkSemver64.to_string modver.version);
              Some (modver.id, modver.version)
          | MlFront_Thunk.ThunkLuaTypAnalysis.StandardModuleExport _
          | MlFront_Thunk.ThunkLuaTypAnalysis.FreeRuleExport _
          | MlFront_Thunk.ThunkLuaTypAnalysis.UiRuleExport _ ->
              None)
        flat_analysis
    else []
  in

  (* Start Lua state *)
  let g, dostring, doscript, run_interactive =
    if options.analysis then
      (* Analysis: Same as VALUESCAN runner, with fresh state *)
      let module Runner =
        ShellCoreLua.MakeRunner
          (ForAnalysis)
          (MlFront_Thunk.ThunkLuaScript.IAnalyze)
      in
      let g = Runner.mk () in
      let doscript lua_file =
        let analysis = Runner.dofile_analysis g lua_file in
        List.iter
          (fun dr ->
            Printf.printf "(analysis) %s\n"
              (MlFront_Thunk.ThunkLuaTypAnalysis.show dr))
          analysis
      in
      (g, Runner.dostring, doscript, Runner.run_interactive)
    else begin
      (* Build ... *)
      let source_file, (_source_sha256, _vsl_source_sz) =
        ShellCoreLua.mk_source cmdline
      in
      try
        (* Start config *)
        let preconfig, ctx =
          ShellCoreLua.start_config ~baseconfig ~install ~random_seed ~verbosity
            ~progress ~nobuiltininc ~nosysinc ~noworkspaceinc ~sysincludedirs
            ~userincludedirs ~cells ~local_packages ~build_number ~long_ids
            ~import debugmodes module_or
        in

        (* Calculate the origin of the valuescan *)
        let lua_valuescan_origin =
          if options.valuescan then `UserRanLuaWithValueScan
          else `UserRanLuaWithoutValueScan
        in

        (* Start build *)
        let g, dostring, doscript, run_interactive, _tasks, _state, _newgen =
          (* Create a transaction dedicated to this build *)
          let parent_txn = None in
          ShellCoreLua.start_build ~preconfig ctx ~command_name:"lua"
            ~lua_valuescan_origin ~prefetch2_lua_scripts ~wait_trace_store
            ~invalidations parent_txn
        in
        (g, dostring, doscript, run_interactive)
      with
      | DkZero_Base.Exceptions.EngineShutdown
          { trace; exitcode_posix; exitcode_windows }
      ->
        ShellBacktrace.process_exception ~trace ~exitcode_posix
          ~exitcode_windows ~cant_do:"run Lua command" ~source_file
          ~autofix:false module_or
    end
  in

  (* Set the 'arg' global table. *)
  let argtable_statement =
    ShellCoreLua.create_argtable_statement options.lua_args
  in
  let (_ : MlFront_Thunk.ThunkLuaScript.Value.value list) =
    dostring ~exit_on_error:true ~sourcename:"<argtable>" g argtable_statement
  in

  (* Evaluate scripts and libraries. *)
  let lua_args3 = nanopass3 options.lua_args in
  let (_ : Wiring.BuildContext.State.t option) =
    try
      ShellCoreLua.evaluate_args ~command_name:"lua" ~dostring ~doscript g
        lua_args3
    with
    | ShellCoreLua.LuaEngineShutdown
        { trace; exitcode_posix; exitcode_windows; lua_source_file; cant_do }
    ->
      ShellBacktrace.process_exception ~trace ~exitcode_posix ~exitcode_windows
        ~cant_do ~source_file:lua_source_file ~autofix:false module_or
  in

  (* Use stdin to make a REPL *)
  if options.interactive then (
    Printf.printf "dk/Lua %s REPL%s.\nUse Ctrl-C %s to exit the REPL.\n%!"
      MlFront_Core.MlFrontConstants.mlfront_version
      (if options.analysis then " in analysis mode" else "")
      (if Sys.win32 then "(or Ctrl-Z + RETURN on a blank line on Windows)"
       else "(or Ctrl-D on Unix)");
    run_interactive ~prompt:">" ~sourcename:"<repl>" stdin g)