Commits

Markus Mottl committed ef5cff4

Improved handling of record field defaults in sexplib

Comments (0)

Files changed (1)

base/sexplib/syntax/pa_sexp_conv.ml

 module Generate_sexp_of = struct
   (* Handling of record defaults *)
 
-  type record_field_handler = [ `keep | `drop | `drop_if of Ast.expr ]
+  type record_field_handler = [ `keep | `drop_default | `drop_if of Ast.expr ]
 
   let record_field_handlers = Hashtbl.create 0
 
   let () =
     Pa_type_conv.add_record_generator "sexp_drop_default" (fun loc ->
       check_record_field_handler loc;
-      Hashtbl.replace record_field_handlers loc `drop)
+      Hashtbl.replace record_field_handlers loc `drop_default)
 
   let () =
     Pa_type_conv.add_record_generator_with_arg "sexp_drop_if"
             ~sexp_of:<:expr@loc< sexp_of_array >> <:expr@loc< [||] >>
       | <:ctyp@loc< $lid:name$ : mutable $tp$ >>
       | <:ctyp@loc< $lid:name$ : $tp$ >> ->
-          let emit () =
-            let patt = mk_rec_patt loc patt name in
-            let vname = <:expr@loc< $lid:"v_" ^ name$ >> in
-            let cnv_expr = unroll_cnv_fp loc vname (sexp_of_type tp) in
-            let expr =
-              <:expr@loc<
-                let arg = $cnv_expr$ in
-                let bnd =
-                  Sexplib.Sexp.List [Sexplib.Sexp.Atom $str:name$; arg]
-                in
-                let bnds = [ bnd :: bnds ] in
-                $expr$
-              >>
-            in
-            patt, expr
-          in
-          begin match Pa_type_conv.Gen.find_record_default loc with
-          | None -> emit ()
-          | Some default ->
-              match get_record_field_handler loc with
-              | `keep -> emit ()
-              | `drop -> sexp_of_default_field patt expr name tp default
-              | `drop_if test -> sexp_of_record_field patt expr name tp test
+          let opt_default = Pa_type_conv.Gen.find_record_default loc in
+          let field_handler = get_record_field_handler loc in
+          begin match opt_default, field_handler with
+          | None, `drop_default -> Loc.raise loc (Failure "no default to drop")
+          | _, `drop_if test -> sexp_of_record_field patt expr name tp test
+          | Some default, `drop_default ->
+              sexp_of_default_field patt expr name tp default
+          | _, `keep ->
+              let patt = mk_rec_patt loc patt name in
+              let vname = <:expr@loc< $lid:"v_" ^ name$ >> in
+              let cnv_expr = unroll_cnv_fp loc vname (sexp_of_type tp) in
+              let expr =
+                <:expr@loc<
+                  let arg = $cnv_expr$ in
+                  let bnd =
+                    Sexplib.Sexp.List [Sexplib.Sexp.Atom $str:name$; arg]
+                  in
+                  let bnds = [ bnd :: bnds ] in
+                  $expr$
+                >>
+              in
+              patt, expr
           end
       | _ -> assert false  (* impossible *)
     in
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.