diff --git a/compiler/lib/build_info.ml b/compiler/lib/build_info.ml index df09835ca..3d723a5c3 100644 --- a/compiler/lib/build_info.ml +++ b/compiler/lib/build_info.ml @@ -90,19 +90,9 @@ let parse s = in Some t -let to_sexp info = - Sexp.List - (info - |> StringMap.bindings - |> List.map ~f:(fun (k, v) -> Sexp.List [ Atom k; Atom v ])) - -let from_sexp info = - let open Sexp.Util in - info - |> assoc - |> List.fold_left - ~f:(fun m (k, v) -> StringMap.add k (single string v) m) - ~init:StringMap.empty +let to_map : t -> string StringMap.t = Fun.id + +let of_map : string StringMap.t -> t = Fun.id exception Incompatible_build_info of diff --git a/compiler/lib/build_info.mli b/compiler/lib/build_info.mli index 34c72abbc..f80eee164 100644 --- a/compiler/lib/build_info.mli +++ b/compiler/lib/build_info.mli @@ -34,9 +34,9 @@ val to_string : t -> string val parse : string -> t option -val to_sexp : t -> Sexp.t +val to_map : t -> string StringMap.t -val from_sexp : Sexp.t -> t +val of_map : string StringMap.t -> t val with_kind : t -> kind -> t diff --git a/compiler/lib/unit_info.ml b/compiler/lib/unit_info.ml index 6daa29e73..bcc168a56 100644 --- a/compiler/lib/unit_info.ml +++ b/compiler/lib/unit_info.ml @@ -149,43 +149,3 @@ let parse acc s = | Some ("Effects_without_cps", b) -> Some { acc with effects_without_cps = bool_of_string (String.trim b) } | Some (_, _) -> None) - -let to_sexp t = - let add nm skip v rem = if skip then rem else Sexp.List (Atom nm :: v) :: rem in - let set nm f rem = - add - nm - (List.equal ~eq:String.equal (f empty) (f t)) - (List.map ~f:(fun x -> Sexp.Atom x) (f t)) - rem - in - let bool nm f rem = - add - nm - (Bool.equal (f empty) (f t)) - (if f t then [ Atom "true" ] else [ Atom "false" ]) - rem - in - [] - |> bool "effects_without_cps" (fun t -> t.effects_without_cps) - |> set "primitives" (fun t -> t.primitives) - |> bool "force_link" (fun t -> t.force_link) - |> set "requires" (fun t -> StringSet.elements t.requires) - |> add "provides" false [ Atom (StringSet.choose t.provides) ] - -let from_sexp t = - let open Sexp.Util in - let opt_list l = l |> Option.map ~f:(List.map ~f:string) in - let list default l = Option.value ~default (opt_list l) in - let set default l = - Option.value ~default (Option.map ~f:StringSet.of_list (opt_list l)) - in - let bool default v = Option.value ~default (Option.map ~f:(single bool) v) in - { provides = t |> member "provides" |> mandatory (single string) |> StringSet.singleton - ; requires = t |> member "requires" |> set empty.requires - ; primitives = t |> member "primitives" |> list empty.primitives - ; force_link = t |> member "force_link" |> bool empty.force_link - ; effects_without_cps = - t |> member "effects_without_cps" |> bool empty.effects_without_cps - ; crcs = StringMap.empty - } diff --git a/compiler/lib/unit_info.mli b/compiler/lib/unit_info.mli index cd0895fa9..1899b5657 100644 --- a/compiler/lib/unit_info.mli +++ b/compiler/lib/unit_info.mli @@ -41,7 +41,3 @@ val prefix : string val to_string : t -> string val parse : t -> string -> t option - -val to_sexp : t -> Sexp.t list - -val from_sexp : Sexp.t -> t diff --git a/compiler/lib/sexp.ml b/compiler/lib/wasm/sexp.ml similarity index 100% rename from compiler/lib/sexp.ml rename to compiler/lib/wasm/sexp.ml diff --git a/compiler/lib/sexp.mli b/compiler/lib/wasm/sexp.mli similarity index 100% rename from compiler/lib/sexp.mli rename to compiler/lib/wasm/sexp.mli diff --git a/compiler/lib/wasm/wa_link.ml b/compiler/lib/wasm/wa_link.ml index 93aa9d82f..453c65858 100644 --- a/compiler/lib/wasm/wa_link.ml +++ b/compiler/lib/wasm/wa_link.ml @@ -20,6 +20,82 @@ open Stdlib let times = Debug.find "times" +module Build_info : sig + include module type of Build_info + + val to_sexp : t -> Sexp.t + + val from_sexp : Sexp.t -> t +end = struct + include Build_info + + let to_sexp info = + Sexp.List + (info + |> to_map + |> StringMap.bindings + |> List.map ~f:(fun (k, v) -> Sexp.List [ Atom k; Atom v ])) + + let from_sexp info = + let open Sexp.Util in + info + |> assoc + |> List.fold_left + ~f:(fun m (k, v) -> StringMap.add k (single string v) m) + ~init:StringMap.empty + |> of_map +end + +module Unit_info : sig + include module type of Unit_info + + val to_sexp : t -> Sexp.t list + + val from_sexp : Sexp.t -> t +end = struct + include Unit_info + + let to_sexp t = + let add nm skip v rem = if skip then rem else Sexp.List (Atom nm :: v) :: rem in + let set nm f rem = + add + nm + (List.equal ~eq:String.equal (f empty) (f t)) + (List.map ~f:(fun x -> Sexp.Atom x) (f t)) + rem + in + let bool nm f rem = + add + nm + (Bool.equal (f empty) (f t)) + (if f t then [ Atom "true" ] else [ Atom "false" ]) + rem + in + [] + |> bool "effects_without_cps" (fun t -> t.effects_without_cps) + |> set "primitives" (fun t -> t.primitives) + |> bool "force_link" (fun t -> t.force_link) + |> set "requires" (fun t -> StringSet.elements t.requires) + |> add "provides" false [ Atom (StringSet.choose t.provides) ] + + let from_sexp t = + let open Sexp.Util in + let opt_list l = l |> Option.map ~f:(List.map ~f:string) in + let list default l = Option.value ~default (opt_list l) in + let set default l = + Option.value ~default (Option.map ~f:StringSet.of_list (opt_list l)) + in + let bool default v = Option.value ~default (Option.map ~f:(single bool) v) in + { provides = t |> member "provides" |> mandatory (single string) |> StringSet.singleton + ; requires = t |> member "requires" |> set empty.requires + ; primitives = t |> member "primitives" |> list empty.primitives + ; force_link = t |> member "force_link" |> bool empty.force_link + ; effects_without_cps = + t |> member "effects_without_cps" |> bool empty.effects_without_cps + ; crcs = StringMap.empty + } +end + module Wasm_binary = struct let header = "\000asm\001\000\000\000"