From 21615a797fced1274bee042be1ef52dc34752802 Mon Sep 17 00:00:00 2001 From: Prashanth Mundkur Date: Wed, 29 Apr 2009 14:52:01 -0700 Subject: [PATCH] implement the record trimming pragma --- gen/json_conv/codegen.ml | 26 +++++++++++++++----------- gen/json_conv/gen_json_conv.ml | 5 +++-- 2 files changed, 18 insertions(+), 13 deletions(-) diff --git a/gen/json_conv/codegen.ml b/gen/json_conv/codegen.ml index 4b70e2f..cbb0ab9 100644 --- a/gen/json_conv/codegen.ml +++ b/gen/json_conv/codegen.ml @@ -91,6 +91,12 @@ module Var_env = struct (List.rev vlist), env end +let verbose = ref false + +let dbg = + let logger s = if !verbose then Printf.printf "%s" s in + Printf.ksprintf logger + module Pragma = struct exception Missing_prefix of string * string @@ -126,22 +132,19 @@ module Pragma = struct let record_prefix = ref "" let process_pragma p = let p = clist_to_str (trim p) in - (* Printf.printf "Saw pragma %s\n" p; *) + dbg "Saw pragma %s.\n" p; if is_prefix "set_record_prefix=" p then begin record_prefix := strip_prefix "set_record_prefix=" p; - (* Printf.printf "Set record prefix to \"%s\"\n" !record_prefix *) + dbg "Set record prefix to \"%s\".\n" !record_prefix end else if is_prefix "clear_record_prefix" p then begin - record_prefix := ""; - (* Printf.printf "Cleared record prefix\n" *) + dbg "Cleared record prefix (was \"%s\").\n" !record_prefix; + record_prefix := "" end - let cook_To_field_name fn = + let json_field_name fn = if is_prefix !record_prefix fn then strip_prefix !record_prefix fn else raise (Missing_prefix (!record_prefix, fn)) - - let cook_Of_field_name fn = - !record_prefix ^ fn end type rec_type = First | Next @@ -156,8 +159,9 @@ module To = struct let constr = if constr = "" then "" else "(Json_conv.string_to_json \"" ^ constr ^ "\"); " in "[| " ^ constr ^ (String.concat "; " elems) ^ " |]" - let to_object_str fn_list fv_list = + let to_object_str ?(is_record=false) fn_list fv_list = let elems = List.map2 (fun f v -> + let f = if is_record then Pragma.json_field_name f else f in Printf.sprintf "(\"%s\", %s)" f (name_of_var v) ) fn_list fv_list in "[| " ^ (String.concat "; " elems) ^ " |]" @@ -220,7 +224,7 @@ module To = struct List.iter2 (fun letv (fv, ft) -> let_bind ff venv letv fv ft ) letvlist (List.combine fvlist ftlist); - fprintf ff "Json.Object %s@]@,)" (to_object_str fnlist letvlist) + fprintf ff "Json.Object %s@]@,)" (to_object_str ~is_record:true fnlist letvlist) | C_variant cdlist -> fprintf ff "(match %s with@," v; List.iter (fun cd -> variant ff venv cd) cdlist; @@ -322,7 +326,7 @@ module From = struct List.iter2 (fun letv (fn, ft) -> let fvar, venv = Var_env.new_ident_from_name venv ~suffix:"_f" fn in let optional = match ft with C_option _ -> "optional_" | _ -> "" in - fprintf ff "let %s = Json_conv.get_%sobject_field %s \"%s\" in@," (name_of_var fvar) optional objtvn fn; + fprintf ff "let %s = Json_conv.get_%sobject_field %s \"%s\" in@," (name_of_var fvar) optional objtvn (Pragma.json_field_name fn); let_bind ff venv letv fvar ft tname ) letvlist cls; fprintf ff "%s" (to_record_str fnlist letvlist) diff --git a/gen/json_conv/gen_json_conv.ml b/gen/json_conv/gen_json_conv.ml index dfb83cd..c3278dc 100644 --- a/gen/json_conv/gen_json_conv.ml +++ b/gen/json_conv/gen_json_conv.ml @@ -64,8 +64,9 @@ let () = (* parse argv *) let larg = [ - ("-i", Arg.Set_string input, "input file"); - ("-o", Arg.Set_string output, "output file"); + ("-i", Arg.Set_string input, " input file"); + ("-o", Arg.Set_string output, " output file"); + ("-d", Arg.Set Codegen.verbose, " debug codegen logging"); ] in let usage_msg = Printf.sprintf "%s -i [-o ]" Sys.argv.(0) in Arg.parse larg (fun s -> ()) usage_msg; -- 2.39.5