Merge pull request mirage#76 from mseri/master

lib: remove use of codegen after dropping support for ocaml 4.02.3

lib/codegen.cppo.ml → lib/codegen.ml

@@ -1,9 +1,3 @@
-#if OCAML_VERSION < (4, 03, 0)
- #define capitalize String.capitalize
-#else
- #define capitalize String.capitalize_ascii
-#endif
-
 open Rpc.Types
 
 type _ outerfn =
@@ -100,7 +94,7 @@ module Gen () = struct
 
  let implement i () =
  let n = i.Interface.name in
- if capitalize n <> n then failwith "Interface names must be capitalized";
+ if String.capitalize_ascii n <> n then failwith "Interface names must be capitalized";
  let i = Interface.({details=i; methods=(List.rev !methods)}) in
  i
 

lib/rpc.cppo.ml → lib/rpc.ml

@@ -15,13 +15,6 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)
 
-#if OCAML_VERSION < (4, 03, 0)
- #define lowercase String.lowercase
-#else
- #define lowercase String.lowercase_ascii
-#endif
-
-
 let debug = ref false
 let set_debug x = debug := x
 let get_debug () = !debug
@@ -196,7 +189,7 @@ let char_of_rpc x =
  then failwith (Printf.sprintf "Char out of range (%d)" x)
  else Char.chr x
 let t_of_rpc t = t
-let lowerfn = function | String s -> String (lowercase s) | Enum (String s::ss) -> Enum ((String (lowercase s))::ss) | x -> x
+let lowerfn = function | String s -> String (String.lowercase_ascii s) | Enum (String s::ss) -> Enum ((String (String.lowercase_ascii s))::ss) | x -> x
 
 module ResultUnmarshallers = struct
  open Rresult

lib/rpcmarshal.cppo.ml → lib/rpcmarshal.ml

@@ -1,9 +1,3 @@
-#if OCAML_VERSION < (4, 03, 0)
- #define lowercase String.lowercase
-#else
- #define lowercase String.lowercase_ascii
-#endif
-
 (* Basic type definitions *)
 open Rpc.Types
 
@@ -91,10 +85,10 @@ let rec unmarshal : type a. a typ -> Rpc.t -> (a, err) Result.result = fun t v
  | Struct { constructor; sname } -> begin
  match v with
  | Rpc.Dict keys' ->
- let keys = List.map (fun (s,v) -> (lowercase s, v)) keys' in
+ let keys = List.map (fun (s,v) -> (String.lowercase_ascii s, v)) keys' in
  constructor { fget = (
  let x : type a. string -> a typ -> (a, Rresult.R.msg) Result.result = fun s ty ->
- let s = lowercase s in
+ let s = String.lowercase_ascii s in
  match ty with
  | Option x -> begin try List.assoc s keys |> unmarshal x >>= fun o -> return (Some o) with _ -> return None end
  | y ->

ppx/ppx_deriving_rpc.cppo.ml

@@ -1,11 +1,3 @@
-#if OCAML_VERSION < (4, 03, 0)
- #define Pconst_string Const_string
- #define Pcstr_tuple(x) x
- #define lowercase String.lowercase
-#else
- #define lowercase String.lowercase_ascii
-#endif
-
 open Longident
 open Asttypes
 open Parsetree
@@ -148,15 +140,15 @@ module Of_rpc = struct
 #if OCAML_VERSION > (4, 05, 0)
  let label = label.txt in
 #endif
- let label' = lowercase label in
+ let label' = String.lowercase_ascii label in
  Exp.case
  [%pat? Rpc.String [%p pstr (attr_name label' attrs)]]
  (Exp.variant label None)
  | Rtag (label, attrs, false, [ { ptyp_desc = Ptyp_tuple typs }]) ->
 #if OCAML_VERSION > (4, 05, 0)
  let label = label.txt in
 #endif
- let label' = lowercase label in
+ let label' = String.lowercase_ascii label in
  let exprs = List.mapi (fun i typ -> [%expr [%e expr_of_typ typ] [%e evar (argn i) ] ] ) typs in
  Exp.case
  [%pat? Rpc.Enum [Rpc.String [%p pstr (attr_name label' attrs)];
@@ -166,7 +158,7 @@ module Of_rpc = struct
 #if OCAML_VERSION > (4, 05, 0)
  let label = label.txt in
 #endif
- let label' = lowercase label in
+ let label' = String.lowercase_ascii label in
  Exp.case
  [%pat? Rpc.Enum [Rpc.String [%p pstr (attr_name label' attrs)]; y]]
  [%expr [%e expr_of_typ typ] y |> fun x ->
@@ -186,8 +178,8 @@ module Of_rpc = struct
  in
  [%expr fun (rpc : Rpc.t) ->
  let rpc' = match rpc with
- | Rpc.Enum ((Rpc.String x)::xs) -> Rpc.Enum ((Rpc.String (lowercase x))::xs)
- | Rpc.String x -> Rpc.String (lowercase x)
+ | Rpc.Enum ((Rpc.String x)::xs) -> Rpc.Enum ((Rpc.String (String.lowercase_ascii x))::xs)
+ | Rpc.String x -> Rpc.String (String.lowercase_ascii x)
  | y -> y in
  [%e Exp.match_ [%expr rpc'] (tag_cases @ [inherits_case])]]
 
@@ -224,7 +216,7 @@ module Of_rpc = struct
  let record =
  List.fold_left (fun expr (i,label) ->
  let { pld_name = { txt = name }; pld_attributes } = label in
- let key = lowercase (attr_key name pld_attributes) in
+ let key = String.lowercase_ascii (attr_key name pld_attributes) in
  [%expr let [%p pvar (argn i)] = match [%e evar (argn i)] with | Some x -> x | None -> failwith (Printf.sprintf "Undefined field: Expecting '%s'" [%e str key]) in [%e expr]])
  [%expr [%e Exp.record (labels |> List.mapi (fun i { pld_name = { txt = name } } ->
  mknoloc (Lident name), evar (argn i))) None]]
@@ -237,7 +229,7 @@ module Of_rpc = struct
  if i = j
  then [%expr Some [%e app (expr_of_typ pld_type) [(wrap_opt pld_type (evar "x"))]]]
  else evar (argn j)) in
- Exp.case [%pat? ([%p pstr (lowercase (attr_key name pld_attributes))], x) :: xs]
+ Exp.case [%pat? ([%p pstr (String.lowercase_ascii (attr_key name pld_attributes))], x) :: xs]
  [%expr loop xs [%e tuple thunks]])) @
  [Exp.case [%pat? []] record;
  Exp.case [%pat? _ :: xs] [%expr loop xs _state]]
@@ -250,7 +242,7 @@ module Of_rpc = struct
  [%expr fun x ->
  match x with
  | Rpc.Dict dict ->
- let d' = List.map (fun (k,v) -> (lowercase k, v)) dict in
+ let d' = List.map (fun (k,v) -> (String.lowercase_ascii k, v)) dict in
  let rec loop xs ([%p ptuple (List.mapi (fun i _ -> pvar (argn i)) labels)] as _state) =
  [%e Exp.match_ [%expr xs] cases]
  in loop d' [%e tuple thunks]
@@ -267,16 +259,14 @@ module Of_rpc = struct
  let subpattern = List.mapi (fun i _ -> pvar (argn i)) typs |> plist in
  let exprs = List.mapi (fun i typ -> [%expr [%e expr_of_typ typ] [%e evar (argn i) ] ] ) typs in
  let rpc_of = constr name exprs in
- let main = [%pat? Rpc.String [%p pstr (lowercase (attr_name name pcd_attributes))]] in
+ let main = [%pat? Rpc.String [%p pstr (String.lowercase_ascii (attr_name name pcd_attributes))]] in
  let pattern = match typs with
  | [] -> main
  | _ -> [%pat? Rpc.Enum ([%p main] :: [%p subpattern])]
  in
  Exp.case pattern rpc_of
-#if OCAML_VERSION >= (4, 03, 0)
  | Pcstr_record _ ->
  raise_errorf "%s: record variants are not supported" deriver
-#endif
  ) in
  let default =
  Exp.case
@@ -420,10 +410,8 @@ module Rpc_of = struct
  | args -> [%expr Rpc.Enum ((Rpc.String [%e str (attr_name name pcd_attributes)]) :: [%e argsl])]
  in
  Exp.case (pconstr name pattern) rpc_of
-#if OCAML_VERSION >= (4, 03, 0)
  | Pcstr_record _ ->
  raise_errorf "%s: record variants are not supported" deriver
-#endif
  ) in
  Exp.function_ cases
  in

ppx/ppx_deriving_rpcty.cppo.ml

@@ -1,11 +1,3 @@
-#if OCAML_VERSION < (4, 03, 0)
- #define Pconst_string Const_string
- #define Pcstr_tuple(x) x
- #define lowercase String.lowercase
-#else
- #define lowercase String.lowercase_ascii
-#endif
-
 open Longident
 open Asttypes
 open Parsetree
@@ -186,13 +178,11 @@ module Typ_of = struct
  let cases =
  constrs |> List.map (fun { pcd_name = { txt = name }; pcd_args; pcd_attributes } ->
  let rpc_name = attr_name name pcd_attributes in
- let lower_rpc_name = lowercase rpc_name in
+ let lower_rpc_name = String.lowercase_ascii rpc_name in
  let typs = match pcd_args with
  | Pcstr_tuple(typs) -> typs
-#if OCAML_VERSION >= (4, 03, 0)
  | Pcstr_record _ ->
  raise_errorf "%s: record variants are not supported" deriver
-#endif
  in
  let contents = match typs with
  | [] -> [%expr Unit]
@@ -223,7 +213,7 @@ module Typ_of = struct
  (match default_case with
  | None -> [%expr Rresult.R.error_msg (Printf.sprintf "Unknown tag '%s'" s)]
  | Some d -> [%expr Result.Ok [%e d]])] in
- let vconstructor = [%expr fun s' t -> let s = lowercase s' in [%e Exp.match_ (evar "s") ((List.map snd cases) @ default)]] in
+ let vconstructor = [%expr fun s' t -> let s = String.lowercase_ascii s' in [%e Exp.match_ (evar "s") ((List.map snd cases) @ default)]] in
  [ Vb.mk (pvar typ_of_lid) (wrap_runtime (polymorphize (
  [%expr Variant ({
  variants=([%e list (List.map fst cases)]);