Source file driver.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
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 ())

let wat_to_binary ?(color = Wax_utils.Colors.Never)
    ?(defines = Wax_wasm.Cond_specialize.of_list []) ?(name_functions = false)
    ?(validate = false) ?(warn_unused = validate) ~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);
  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) ~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);
  to_binary ~color ~source:(Some text) wasm_ast

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