Source file driver.ml

type binary_module = Wax_wasm.Ast.location Wax_wasm.Ast.Binary.module_

(* Pre-instantiated parsers, matching the wiring in [src/bin/main.ml]. *)

module Wat_parser =
  Wax_utils.Parsing.Make_parser
    (struct
      type t = Wax_wasm.Ast.location Wax_wasm.Ast.Text.module_
    end)
    (Wax_wasm.Tokens)
    (Wax_wasm.Parser)
    (Wax_wasm.Fast_parser)
    (Wax_wasm.Parser_messages)
    (Wax_wasm.Lexer)

module Wax_parser =
  Wax_utils.Parsing.Make_parser
    (struct
      type t = Wax_lang.Ast.location Wax_lang.Ast.module_
    end)
    (Wax_lang.Tokens)
    (Wax_lang.Parser)
    (Wax_lang.Fast_parser)
    (Wax_lang.Parser_messages)
    (Wax_lang.Lexer)

let wax_parse_recover ~filename text =
  Wax_parser.parse_recover ~filename ~sync:Wax_lang.Recover.sync
    ~insert:Wax_lang.Recover.insert ~closers:Wax_lang.Recover.closers text

let wat_parse_recover ~filename text =
  Wat_parser.parse_recover ~filename ~sync:Wax_wasm.Recover.sync
    ~insert:Wax_wasm.Recover.insert ~closers:Wax_wasm.Recover.closers
    ~barrier:Wax_wasm.Recover.barrier text

(* Lower a text module to the binary format. A leftover conditional annotation
   cannot be represented in binary, and a named reference may resolve to
   nothing; report either as a located diagnostic (rather than an uncaught
   exception) and suggest a way out. *)
let to_binary ~color ~source ast =
  Wax_utils.Diagnostic.run ~color ~palette:Wax_utils.Colors.wax_theme ~source
    (fun d ->
      try Wax_wasm.Text_to_binary.module_ ast with
      | Wax_wasm.Text_to_binary.Conditional_in_binary location ->
          Wax_utils.Diagnostic.report d ~location ~severity:Error
            ~message:
              (Wax_utils.Message.text
                 "Conditional annotations cannot be emitted to the WebAssembly \
                  binary format.")
            ~hint:
              (Wax_utils.Message.text
                 "Resolve the conditionals with -D/--define, or convert to a \
                  text format (wat or wax).")
            ();
          Wax_utils.Diagnostic.abort ()
      | Wax_wasm.Text_to_binary.Unresolved_reference (location, message) ->
          Wax_utils.Diagnostic.report d ~location ~severity:Error
            ~message:(Wax_utils.Message.text message)
            ();
          Wax_utils.Diagnostic.abort ())

(* Rewrite the legacy [try]/[catch] instructions into [try_table] (see
   {!Wax_wasm.Legacy_eh}), when asked to. *)
let lower_legacy_eh ~try_table ~color ~source ast =
  if not try_table then ast
  else
    Wax_utils.Diagnostic.run ~color ~palette:Wax_utils.Colors.wat_theme ~source
      (fun d -> Wax_wasm.Legacy_eh.module_ d ast)

let wat_to_binary ?(color = Wax_utils.Colors.Never)
    ?(defines = Wax_wasm.Cond_specialize.of_list []) ?(name_functions = false)
    ?(validate = false) ?(warn_unused = validate) ?(try_table = false) ~filename
    text =
  let ast, _ctx = Wat_parser.parse_from_string ~color ~filename text in
  let ast =
    if Wax_wasm.Cond_specialize.is_empty defines then ast
    else
      Wax_utils.Diagnostic.run ~color ~palette:Wax_utils.Colors.wat_theme
        ~source:(Some text) (fun d ->
          fst (Wax_wasm.Cond_specialize.module_ d defines ast))
  in
  let ast =
    if name_functions then Naming.name_functions_from_exports ast else ast
  in
  (* Declare any function referenced by [ref.func] only inside a body, so the
     emitted binary passes strict reference validation (as [wat_to_wasm] does in
     the CLI). *)
  let ast = Wax_wasm.Declare_refs.module_ ast in
  if validate then
    Wax_utils.Diagnostic.run ~color ~palette:Wax_utils.Colors.wat_theme
      ~source:(Some text) (fun d -> Wax_wasm.Validation.f ~warn_unused d ast);
  let ast = lower_legacy_eh ~try_table ~color ~source:(Some text) ast in
  to_binary ~color ~source:(Some text) ast

let wax_to_binary ?(color = Wax_utils.Colors.Never)
    ?(defines = Wax_wasm.Cond_specialize.of_list []) ?(validate = false)
    ?(warn_unused = validate) ?(try_table = false) ~filename text =
  let ast, _ctx = Wax_parser.parse_from_string ~color ~filename text in
  let ast =
    if Wax_wasm.Cond_specialize.is_empty defines then ast
    else
      Wax_utils.Diagnostic.run ~color ~palette:Wax_utils.Colors.wax_theme
        ~source:(Some text) (fun d ->
          fst (Wax_lang.Cond_specialize.module_ d defines ast))
  in
  let types, ast =
    Wax_utils.Diagnostic.run ~color ~palette:Wax_utils.Colors.wax_theme
      ~source:(Some text) (fun d -> Wax_lang.Typing.f ~warn_unused d ast)
  in
  let wasm_ast =
    Wax_utils.Diagnostic.run ~color ~palette:Wax_utils.Colors.wax_theme
      ~source:(Some text) (fun d -> To_wasm.module_ d types ast)
  in
  if validate then
    Wax_utils.Diagnostic.run ~color ~palette:Wax_utils.Colors.wat_theme
      ~source:(Some text) (fun d ->
        (* Unused locals are reported against the Wax source by [Typing.f]
           above; do not repeat them against the compiled Wasm. *)
        Wax_wasm.Validation.f ~warn_unused:false d wasm_ast);
  let wasm_ast =
    lower_legacy_eh ~try_table ~color ~source:(Some text) wasm_ast
  in
  to_binary ~color ~source:(Some text) wasm_ast

let output_binary ~out_channel ?(source_map = false) ?(label_names = true) ast =
  Wax_wasm.Wasm_output.module_ ~out_channel ~source_map ~label_names ast