src/compile/compile.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
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145

(* SPDX-License-Identifier: AGPL-3.0-or-later *)
(* Copyright © 2021-2026 OCamlPro *)
(* Written by the Owi programmers *)

open Syntax

module Text = struct
  let until_text_validate ~unsafe m =
    if unsafe then Ok m else Text_validate.modul m

  let until_group ~unsafe m =
    let+ m = until_text_validate ~unsafe m in
    Grouped.of_text m

  let until_assign ~unsafe m =
    let* m = until_group ~unsafe m in
    let+ assigned = Assigned.of_grouped m in
    (m, assigned)

  let until_binary ~unsafe m =
    let* m, assigned = until_assign ~unsafe m in
    Rewrite.modul m assigned

  let until_validate ~unsafe m =
    let* m = until_text_validate ~unsafe m in
    let* m = until_binary ~unsafe m in
    if unsafe then Ok m
    else
      let+ () = Binary_validate.modul m in
      m

  let until_concrete_link ~unsafe ~name env m =
    let* modul = until_validate ~unsafe m in
    let* env = Env.Concrete.link_binary_module ~env ~name ~modul in
    let+ modul = Env.Concrete.get_last_module ~env in
    (modul, env)

  let until_symbolic_link ~unsafe ~name env m =
    let* modul = until_validate ~unsafe m in
    let* env = Env.Symbolic.link_binary_module ~env ~name ~modul in
    let+ modul = Env.Symbolic.get_last_module ~env in
    (modul, env)

  let until_abstract_link ~unsafe ~name env m =
    let* modul = until_validate ~unsafe m in
    let* env = Env.Abstract.link_binary_module ~env ~name ~modul in
    let+ modul = Env.Abstract.get_last_module ~env in
    (modul, env)
end

module Binary = struct
  let until_validate ~unsafe m =
    if unsafe then Ok m
    else
      let+ () = Binary_validate.modul m in
      m

  let until_concrete_link ~unsafe ~name env m =
    let* modul = until_validate ~unsafe m in
    let* env = Env.Concrete.link_binary_module ~env ~name ~modul in
    let+ modul = Env.Concrete.get_last_module ~env in
    (modul, env)

  let until_symbolic_link ~unsafe ~name env m =
    let* modul = until_validate ~unsafe m in
    let* env = Env.Symbolic.link_binary_module ~env ~name ~modul in
    let+ modul = Env.Symbolic.get_last_module ~env in
    (modul, env)

  let until_abstract_link ~unsafe ~name env m =
    let* modul = until_validate ~unsafe m in
    let* env = Env.Abstract.link_binary_module ~env ~name ~modul in
    let+ modul = Env.Abstract.get_last_module ~env in
    (modul, env)
end

module Any = struct
  let until_validate ~unsafe = function
    | Kind.Wat m -> Text.until_validate ~unsafe m
    | Wasm m -> Binary.until_validate ~unsafe m
    | Wast _ -> Fmt.error_msg "can not validate a .wast file"
    | Extern _ -> Fmt.error_msg "can not validate an OCaml module"

  let until_concrete_link ~unsafe ~name env = function
    | Kind.Wat m -> Text.until_concrete_link ~unsafe ~name env m
    | Wasm m -> Binary.until_concrete_link ~unsafe ~name env m
    | Extern _m ->
      (* TODO: Link.Extern.modul m *)
      Fmt.error_msg "can not link an OCaml module"
    | Wast _ -> Fmt.error_msg "can not link a .wast file"

  let until_symbolic_link ~unsafe ~name env = function
    | Kind.Wat m -> Text.until_symbolic_link ~unsafe ~name env m
    | Wasm m -> Binary.until_symbolic_link ~unsafe ~name env m
    | Extern _m ->
      (* TODO: Link.Extern.modul m *)
      Fmt.error_msg "can not link an OCaml module"
    | Wast _ -> Fmt.error_msg "can not link a .wast file"

  let until_abstract_link ~unsafe ~name env = function
    | Kind.Wat m -> Text.until_abstract_link ~unsafe ~name env m
    | Wasm m -> Binary.until_abstract_link ~unsafe ~name env m
    | Extern _m ->
      (* TODO: Link.Extern.modul m *)
      Fmt.error_msg "can not link an OCaml module"
    | Wast _ -> Fmt.error_msg "can not link a .wast file"
end

module File = struct
  let until_binary ~unsafe filename =
    let* m = Parse.guess_from_file filename in
    match m with
    | Kind.Wat m -> Text.until_binary ~unsafe m
    | Wasm m -> Ok m
    | Wast _ | Extern _ -> assert false

  let until_validate ~unsafe filename =
    let* m = Parse.guess_from_file filename in
    Log.bench_fn "validation time" @@ fun () ->
    match m with
    | Kind.Wat m -> Text.until_validate ~unsafe m
    | Wasm m -> Binary.until_validate ~unsafe m
    | Wast _ | Extern _ -> assert false

  let until_concrete_link ~unsafe ~name env filename =
    let* m = Parse.guess_from_file filename in
    match m with
    | Kind.Wat m -> Text.until_concrete_link ~unsafe ~name env m
    | Wasm m -> Binary.until_concrete_link ~unsafe ~name env m
    | Wast _ | Extern _ -> assert false

  let until_symbolic_link ~unsafe ~name env filename =
    let* m = Parse.guess_from_file filename in
    match m with
    | Kind.Wat m -> Text.until_symbolic_link ~unsafe ~name env m
    | Wasm m -> Binary.until_symbolic_link ~unsafe ~name env m
    | Wast _ | Extern _ -> assert false

  let until_abstract_link ~unsafe ~name env filename =
    let* m = Parse.guess_from_file filename in
    match m with
    | Kind.Wat m -> Text.until_abstract_link ~unsafe ~name env m
    | Wasm m -> Binary.until_abstract_link ~unsafe ~name env m
    | Wast _ | Extern _ -> assert false
end