Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Merge pull request #121 from jonludlam/rpc-light-lower

CA-97947: Case-desensitise matching of variant types
  • Loading branch information...
commit 6b42ec06ea2f14e989b41ca61623e53638692703 2 parents 5ff0d5e + 0c7622c
Jon Ludlam jonludlam authored
Showing with 10 additions and 3 deletions.
  1. +4 −3 rpc-light/p4_rpc.ml
  2. +3 −0  rpc-light/rpc.ml
  3. +3 −0  rpc-light/rpc.mli
7 rpc-light/p4_rpc.ml
View
@@ -379,11 +379,12 @@ module Of_rpc = struct
let ids, ctyps = decompose_variants _loc t in
let pattern (n, t) ctyps =
let ids, pids = new_id_list _loc ctyps in
+ let lowern = String.lowercase n in
let patt =
if ids = [] then
- <:patt< Rpc.String $str:n$ >>
+ <:patt< Rpc.String $str:lowern$ >>
else
- <:patt< Rpc.Enum [ Rpc.String $str:n$ :: $patt_list_of_list _loc pids$ ] >> in
+ <:patt< Rpc.Enum [ Rpc.String $str:lowern$ :: $patt_list_of_list _loc pids$ ] >> in
let exprs = List.map2 (create name) ids ctyps in
let body = List.fold_right
(fun a b -> <:expr< $b$ $a$ >>)
@@ -392,7 +393,7 @@ module Of_rpc = struct
<:match_case< $patt$ -> $body$ >> in
let fail_match = <:match_case< $runtime_error name id "Enum[String s;...]"$ >> in
let patterns = mcOr_of_list (List.map2 pattern ids ctyps @ [ fail_match ]) in
- <:expr< match $id$ with [ $patterns$ ] >>
+ <:expr< match Rpc.lowerfn $id$ with [ $patterns$ ] >>
| <:ctyp< option $t$ >> ->
let nid, npid = new_id _loc in
3  rpc-light/rpc.ml
View
@@ -15,6 +15,7 @@
let debug = ref false
let set_debug x = debug := x
let get_debug () = !debug
+let lower = String.lowercase
type t =
| Int of int64
@@ -74,6 +75,8 @@ let string_of_rpc = function String s -> s | _ -> failwith "string_of_rpc"
let dateTime_of_rpc = function DateTime d -> d | _ -> failwith "dateTime_of_rpc"
let unit_of_rpc = function Null -> () | _ -> failwith "unit_of_rpc"
+let lowerfn = function | String s -> String (lower s) | Enum (String s::ss) -> Enum ((String (lower s))::ss) | x -> x
+
type callback = string list -> t -> unit
type call = {
3  rpc-light/rpc.mli
View
@@ -82,3 +82,6 @@ exception Runtime_exception of string * string
(** {2 Debug options} *)
val set_debug : bool -> unit
val get_debug : unit -> bool
+
+(** Helper *)
+val lowerfn : t -> t
Please sign in to comment.
Something went wrong with that request. Please try again.