[json] add auto-generated message; minor cleanups

diff --git a/libs/json/codegen.ml b/libs/json/codegen.ml
index 282fb6c703a6e64cee2db6ec75c004412ce219d1..7301229abc781a4e20cc2b08e2f05d34b6ecc479 100644 (file)
--- a/libs/json/codegen.ml
+++ b/libs/json/codegen.ml
@@ -27,16 +27,7 @@ let name_of_var v =
        | 0 -> Printf.sprintf "%s" v.stem
        | d -> Printf.sprintf "%s_%d" v.stem d
 
-module type VAR_ENV = sig
-       type t
-       val new_env: t
-       val new_ident_from_name: t -> ?prefix:string -> ?suffix:string -> string -> var * t
-       val new_ident_from_type: t -> complex_type -> var * t
-       val new_idents_from_types: t -> complex_type list -> var list * t
-       val new_idents_from_vars: t -> ?prefix:string -> ?suffix:string -> var list -> var list * t
-end
-
-module Var_env : VAR_ENV = struct
+module Var_env = struct
        module StringMap = Map.Make (struct type t = string let compare = compare end)
 
        type name_entry = { cur_mark: int; entries: var list; }
@@ -90,24 +81,30 @@ module Var_env : VAR_ENV = struct
                (List.rev vlist), env
 end
 
+type rec_type = First | Next
+
 module To = struct
        let prod_vars_to_str vlist =
                let elems = List.map name_of_var vlist in
                String.concat ", " elems
+
        let to_array_str ?(constr="") vlist =
                let elems = List.map name_of_var vlist in
                let constr = if constr = "" then "" else "(string_to_json \"" ^ constr ^ "\"); " in
                "[| " ^ 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
                "[| " ^ (String.concat "; " elems) ^ " |]"
+
        let to_record_str fnlist fvlist =
                let fields = List.map2 (fun fn fv ->
                                          Printf.sprintf "%s = %s" fn (name_of_var fv)
                                       ) fnlist fvlist in
                "{ " ^ (String.concat "; " fields) ^ " }"
+
        let rec to_json ff venv inv typ =
                let v = name_of_var inv in
                match typ with
@@ -162,6 +159,7 @@ module To = struct
                        fprintf ff "(match %s with@," v;
                        List.iter (fun cd -> variant ff venv cd) cdlist;
                        fprintf ff ")"
+
        and variant ff venv (CD_tuple (vname, vtlist)) =
                let vlist, venv = Var_env.new_idents_from_types venv vtlist in
                let letvlist, venv = Var_env.new_idents_from_vars venv ~prefix:"j_" vlist in
@@ -173,14 +171,17 @@ module To = struct
                                let_bind ff venv letv v vt
                           ) 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 8>let %s =@," (name_of_var letv);
                to_json ff venv inv typ;
                fprintf ff " in@]@,"
-       let def ff venv fn_name typ is_and =
+
+       let def ff venv fn_name typ recd =
                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
-               fprintf ff "@[<v 8>%s %s %s =@," (if is_and then "and" else "let rec") fn_name (name_of_var inv);
+               let decl = match recd with First -> "let rec" | Next -> "and" in
+               fprintf ff "@[<v 8>%s %s %s =@," decl fn_name (name_of_var inv);
                to_json ff venv inv typ;
                fprintf ff "@]@,@\n"
 end
@@ -188,15 +189,18 @@ end
 module From = struct
        let to_tuple_str ?(constr="") vlist =
                let elems = List.map name_of_var vlist in
-               if List.length elems > 0 then
-                       Printf.sprintf "%s(%s)" constr (String.concat ", " elems)
-               else
-                       Printf.sprintf "%s" constr
+               let len = List.length elems in
+               (match len with
+               | 0 -> Printf.sprintf "%s" constr
+               | 1 -> Printf.sprintf "%s %s" constr (List.hd elems)
+               | _ -> Printf.sprintf "%s (%s)" constr (String.concat ", " elems))
+
        let to_record_str fnlist fvlist =
                let fields = List.map2 (fun fn fv ->
                                          Printf.sprintf "%s = %s" fn (name_of_var fv)
                                       ) fnlist fvlist in
                "{ " ^ (String.concat "; " fields) ^ " }"
+
        let rec of_json ff venv inv typ tname =
                let v = name_of_var inv in
                match typ with
@@ -265,6 +269,7 @@ module From = struct
                        (* need to write a default match case *)
                        fprintf ff "| %s -> raise_unknown_constructor \"%s\" %s@,)"
                                defmatchvn tname defmatchvn
+
        and variant ff venv argsv (CD_tuple (vname, vtlist)) tname =
                let argsvn = name_of_var argsv in
                let vtlen = List.length vtlist in
@@ -280,14 +285,17 @@ module From = struct
                                                indx + 1
                                       ) 1 (List.combine letvlist vtlist));
                fprintf ff "%s@]@," (to_tuple_str ~constr:vname letvlist)
+
        and let_bind ff venv letv inv typ tname =
                fprintf ff "@[<v 8>let %s =@," (name_of_var letv);
                of_json ff venv inv typ tname;
                fprintf ff " in@]@,"
-       let def ff venv fn_name (tname, typ) is_and =
+
+       let def ff venv fn_name (tname, typ) recd =
                let fnv, venv = Var_env.new_ident_from_name venv fn_name in
                let inv, venv = Var_env.new_ident_from_name venv "j" in
-               fprintf ff "@[<v 8>%s %s %s =@," (if is_and then "and" else "let rec") fn_name (name_of_var inv);
+               let decl = match recd with First -> "let rec" | Next -> "and" in
+               fprintf ff "@[<v 8>%s %s %s =@," decl fn_name (name_of_var inv);
                of_json ff venv inv typ tname;
                fprintf ff "@]@,@\n"
 end
@@ -302,6 +310,8 @@ let generate_from_def ff is_and (tname, trep) =
 
 let generate_header ff ifn =
        let md = Filename.basename (Filename.chop_extension ifn) in
+       let call = String.concat " " (Array.to_list Sys.argv) in
+       fprintf ff "(* This file has been auto-generated using \"%s\". *)@\n@\n" call;
        fprintf ff "open Json@\n";
        fprintf ff "open Base_conv@\n";
        fprintf ff "open %s@\n" (String.capitalize md);
@@ -311,12 +321,13 @@ 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
+               generate_to_def ff First h;
+               List.iter (generate_to_def ff Next) t;
+               generate_from_def ff First h;
+               List.iter (generate_from_def ff Next) t
 
 let generate defn_list ofn ifn =
        let ff = formatter_of_out_channel (open_out ofn) in
        generate_header ff ifn;
-       List.iter (generate_one_defn ff) defn_list
+       List.iter (generate_one_defn ff) defn_list;
+       fprintf ff "@?"

diff --git a/libs/json/jsonc.ml b/libs/json/jsonc.ml
index f536e86ba68a58088eecdc23f931436989d6d76e..e4d29fc24dcae2f1d2467f9438340db71a44e28e 100644 (file)
--- a/libs/json/jsonc.ml
+++ b/libs/json/jsonc.ml
@@ -57,9 +57,6 @@ let default_output_filename f =
        let stem = Filename.chop_extension base in
        Filename.concat dir (stem ^ "_json_conv.ml")
 
-let gen_code defn_list f =
-       Codegen.generate defn_list f
-
 let () =
        let input = ref "" in
        let output = ref "" in
@@ -76,4 +73,4 @@ let () =
 
        match !input with
        | "" -> Printf.printf "%s\n" usage_msg
-       | file -> gen_code (parse_file file) !output !input
+       | file -> Codegen.generate (parse_file file) !output !input