Skip to content

Commit

Permalink
Move Sexp functions to wasm/ subdirectory
Browse files Browse the repository at this point in the history
This was made necessary by the changes requested in
ocsigen/js_of_ocaml#1657.
  • Loading branch information
OlivierNicole committed Sep 9, 2024
1 parent 7721b16 commit 6e90b4e
Show file tree
Hide file tree
Showing 7 changed files with 81 additions and 59 deletions.
16 changes: 3 additions & 13 deletions compiler/lib/build_info.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions compiler/lib/build_info.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
40 changes: 0 additions & 40 deletions compiler/lib/unit_info.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
}
4 changes: 0 additions & 4 deletions compiler/lib/unit_info.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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
File renamed without changes.
File renamed without changes.
76 changes: 76 additions & 0 deletions compiler/lib/wasm/wa_link.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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"

Expand Down

0 comments on commit 6e90b4e

Please sign in to comment.