fix record handling, and other minor fixes

diff --git a/libs/json/codegen.ml b/libs/json/codegen.ml
index 96d87a384d0643fa671556e49bb210ec6794865e..26a3dc6d0352ee15aa5e5ad3b26366ec1d6f0352 100644 (file)
--- a/libs/json/codegen.ml
+++ b/libs/json/codegen.ml
@@ -90,12 +90,6 @@ module Var_env : VAR_ENV = struct
                (List.rev vlist), env
 end
 
-module type TO = functor (Var_env: VAR_ENV) -> sig
-       val to_json: formatter ->  Var_env.t -> var -> complex_type
-       val let_bind: formatter -> Var_env.t -> (* out *) var -> (* in *) var -> (* in_type *) complex_type -> unit
-       val def: formatter ->  Var_env.t -> (* top_level_name *) string -> complex_type -> unit
-end
-
 module To = struct
        let prod_vars_to_str vlist =
                let elems = List.map name_of_var vlist in
@@ -106,8 +100,8 @@ module To = struct
                "[| " ^ constr ^ (String.concat "; " elems) ^ " |]"
        let to_object_str fn_list fv_list =
                let elems = List.map2 (fun f v ->
-                                       Printf.sprintf "(%s, %s)" f (name_of_var v)
-                                    ) fn_list fv_list in
+                                       Printf.sprintf "(\"%s\", %s)" f (name_of_var v)
+                                     ) fn_list fv_list in
                "[| " ^ (String.concat "; " elems) ^ " |]"
        let to_record_str fnlist fvlist =
                let fields = List.map2 (fun fn fv ->
@@ -123,9 +117,9 @@ module To = struct
                        let optv, venv' = Var_env.new_ident_from_type venv optt in
                        fprintf ff "(match %s with@," v;
                        fprintf ff "| None -> Json_null@,";
-                       fprintf ff "@[<v 0>@[<v 8>| Some %s -> (@\n" (name_of_var optv);
+                       fprintf ff "@[<v 8>| Some %s ->@," (name_of_var optv);
                        to_json ff venv' optv optt;
-                       fprintf ff "@])@,)@]"
+                       fprintf ff "@]@,)"
                | C_list elemt ->
                        let elemv, venv' = Var_env.new_ident_from_type venv elemt in
                        let jlistv, venv' = Var_env.new_ident_from_name venv' v ~suffix:"_jlist" in
@@ -137,32 +131,33 @@ module To = struct
                        fprintf ff "Json_array (Array.of_list %s)" jlistvn
                | C_array elemt ->
                        let elemv, venv' = Var_env.new_ident_from_type venv elemt in
-                       let arrayv, venv' = Var_env.new_ident_from_name venv' v ~suffix:"_jarray" in
-                       let arrayvn = name_of_var arrayv in
-                       fprintf ff "@[<v 0>@[<v 8>let %s = Array.map (fun %s ->@," arrayvn (name_of_var elemv);
+                       let jarrayv, venv' = Var_env.new_ident_from_name venv' v ~suffix:"_jarray" in
+                       let jarrayvn = name_of_var jarrayv in
+                       fprintf ff "@[<v 8>let %s = Array.map@," jarrayvn;
+                       fprintf ff "@[<v 8>(fun %s ->@," (name_of_var elemv);
                        to_json ff venv' elemv elemt;
-                       fprintf ff "@,) %s in@]@," v;
-                       fprintf ff "Json_array %s@]" arrayvn
+                       fprintf ff "@]@,) %s in@]@," v;
+                       fprintf ff "Json_array %s" jarrayvn
                | C_tuple ctlist ->
                        let cvlist, venv' = Var_env.new_idents_from_types venv ctlist in
                        let letvlist, venv' = Var_env.new_idents_from_vars venv' ~prefix:"j_" cvlist in
                        let cvtlist = List.combine cvlist ctlist in
                        fprintf ff "(match %s with@," v;
-                       fprintf ff "@[<v 0>@[<v 8>| %s ->@," (prod_vars_to_str cvlist);
+                       fprintf ff "@[<v 8>| %s ->@," (prod_vars_to_str cvlist);
                        List.iter2 (fun letv (cv, ct) ->
                                        let_bind ff venv' letv cv ct
                                  ) letvlist cvtlist;
-                       fprintf ff "Json_array %s@]@,)@]" (to_array_str letvlist)
+                       fprintf ff "Json_array %s@]@,)" (to_array_str letvlist)
                | C_record cls ->
                        let fnlist, ftlist = List.split cls in
                        let fvlist, venv' = Var_env.new_idents_from_types venv ftlist in
                        let letvlist, venv' = Var_env.new_idents_from_vars venv' ~prefix:"j_" fvlist in
-                       fprintf ff "match %s with@," v;
-                       fprintf ff "@[<v 0>@[<v 8>| %s ->@," (to_record_str fnlist fvlist);
+                       fprintf ff "(match %s with@," v;
+                       fprintf ff "@[<v 8>| %s ->@," (to_record_str fnlist fvlist);
                        List.iter2 (fun letv (fv, ft) ->
                                        let_bind ff venv' letv fv ft
                                   ) letvlist (List.combine fvlist ftlist);
-                       fprintf ff "Json_array %s@]@,@]" (to_object_str fnlist letvlist)
+                       fprintf ff "Json_object %s@]@,)" (to_object_str fnlist letvlist)
                | C_variant cdlist ->
                        fprintf ff "(match %s with@," v;
                        List.iter (fun cd -> variant ff venv cd) cdlist;
@@ -179,9 +174,9 @@ module To = struct
                           ) letvlist (List.combine vlist vtlist);
                fprintf ff "Json_array %s@]@," (to_array_str ~constr:vname letvlist)
        and let_bind ff venv letv inv typ =
-               fprintf ff "@[<v 0>@[<v 8>let %s =@," (name_of_var letv);
+               fprintf ff "@[<v 8>let %s =@," (name_of_var letv);
                to_json ff venv inv typ;
-               fprintf ff " in@]@,@]"
+               fprintf ff " in@]@,"
        let def ff venv fn_name typ is_and =
                let fnv, venv' = Var_env.new_ident_from_name venv fn_name in
                let inv, venv' = Var_env.new_ident_from_name venv' "o" in
@@ -194,7 +189,7 @@ let generate_to_def ff is_and (tname, trep) =
        let fn = tname ^ "_to_json" in
        To.def ff Var_env.new_env fn trep is_and
 
-let generate_from_def ff (tname, trep) =
+let generate_from_def ff is_and (tname, trep) =
        let fn = tname ^ "_from_json" in
        Printf.printf "Generating %s\n" fn
        (* From.def ff Var_env.new_env Type_env.new_env fn trep *)
@@ -203,13 +198,19 @@ let generate_header ff ifn =
        let md = Filename.basename (Filename.chop_extension ifn) in
        fprintf ff "open Json@\n";
        fprintf ff "open Base_conv@\n";
-       fprintf ff "open %s@\n" (String.capitalize md)
+       fprintf ff "open %s@\n" (String.capitalize md);
+       fprintf ff "@\n"
+
+let generate_one_defn ff td =
+       match td with
+       | [] -> ()
+       | h :: t ->
+               generate_to_def ff false h;
+               List.iter (generate_to_def ff true) t;
+               generate_from_def ff false h;
+               List.iter (generate_from_def ff true) t
 
 let generate defn_list ofn ifn =
-       let generate_one_defn ff td =
-               match td with
-               | [] -> ()
-               | h :: t -> generate_to_def ff false h; List.iter (generate_to_def ff true) t in
        let ff = formatter_of_out_channel (open_out ofn) in
        generate_header ff ifn;
        List.iter (generate_one_defn ff) defn_list

diff --git a/libs/json/parser.mly b/libs/json/parser.mly
index c9eb750d62c4cf85261019f359248541b4b49ba1..534d527ecd6a656a97f9e7d5549eb422ccb0f13c 100644 (file)
--- a/libs/json/parser.mly
+++ b/libs/json/parser.mly
@@ -126,8 +126,8 @@ record:
 field_decls:
 | field_decls SEMI field_decl
        { $3 :: $1 }
-| /* epsilon */
-       { [] }
+| field_decl
+       { [ $1 ] }
 
 field_decl:
 | LIDENT COLON expr