From: Prashanth Mundkur <prashanth.mundkur@citrix.com>
Date: Wed, 8 Apr 2009 19:14:23 +0000 (-0700)
Subject: fix option_of_json; some cleanup
X-Git-Url: http://xenbits.xensource.com/gitweb?a=commitdiff_plain;h=d0406b2e30560b090abea999532250fea29baa6b;p=xenclient%2Ftoolstack.git

fix option_of_json; some cleanup
---

diff --git a/libs/json/codegen.ml b/libs/json/codegen.ml
index 77dec51..b7a0122 100644
--- a/libs/json/codegen.ml
+++ b/libs/json/codegen.ml
@@ -193,7 +193,7 @@ module To = struct
 		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"
+		fprintf ff "@]@,@\n@?"
 end
 
 module From = struct
@@ -223,9 +223,9 @@ module From = struct
 			let optv, venv = Var_env.new_ident_from_type venv optt in
 			fprintf ff "(match %s with@," v;
 			fprintf ff "| Json_null -> None@,";
-			fprintf ff "@[<v 8>| %s ->@," (name_of_var optv);
+			fprintf ff "@[<v 8>| %s -> @,Some (" (name_of_var optv);
 			of_json ff venv optv optt tname;
-			fprintf ff "@]@,)"
+			fprintf ff ")@]@,)"
 		| C_list elemt ->
 			let elemv, venv = Var_env.new_ident_from_type venv elemt in
 			let oarrayv, venv = Var_env.new_ident_from_name venv v ~suffix:"_oarray" in
@@ -310,16 +310,14 @@ module From = struct
 		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"
+		fprintf ff "@]@,@\n@?"
 end
 
 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
+	To.def ff Var_env.new_env (tname ^ "_to_json") trep is_and
 
 let generate_from_def ff is_and (tname, trep) =
-	let fn = tname ^ "_of_json" in
-	From.def ff Var_env.new_env fn (tname, trep) is_and
+	From.def ff Var_env.new_env (tname ^ "_of_json") (tname, trep) is_and
 
 let generate_header ff ifn =
 	let md = Filename.basename (Filename.chop_extension ifn) in
@@ -327,8 +325,7 @@ let generate_header ff ifn =
 	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);
-	fprintf ff "@\n"
+	fprintf ff "open %s@\n@\n" (String.capitalize md)
 
 let generate_one_defn ff td =
 	match td with
@@ -341,16 +338,14 @@ let generate_one_defn ff td =
 		List.iter (generate_from_def ff Next) t
 
 let generate defn_list ofn ifn =
+	reset_known_types ();
 	let oc = open_out ofn in
 	let ff = formatter_of_out_channel oc in
-	reset_known_types ();
 	try
 		generate_header ff ifn;
 		List.iter (generate_one_defn ff) defn_list;
-		fprintf ff "@?";
 		close_out oc
-	with
-	| Unknown_base_type id ->
+	with Unknown_base_type id ->
 		Printf.eprintf "Error: Unknown base type \"%s\"\n" id;
 		close_out oc;
 		Unix.unlink ofn
diff --git a/libs/json/lexer.mll b/libs/json/lexer.mll
index 74def13..0407684 100644
--- a/libs/json/lexer.mll
+++ b/libs/json/lexer.mll
@@ -44,35 +44,29 @@ let ident_others  = letter | ['0'-'9'] | '_' | '\'' | '.'
 let ident = ident_first ident_others*
 
 rule main = parse
-| [' ' '\009' '\012' '\r']+
-	{ main lexbuf }
-| ['\n']
-	{ new_line lexbuf;
-	  main lexbuf
-	}
-| "*/"
-	{ raise_syntax_error Unmatched_comment (lexeme_start_p lexbuf) }
-| "/*"
-	{ comment_depth := 1;
-	  comment_start := lexeme_start_p lexbuf;
-	  comment lexbuf;
-	  main lexbuf
-	}
+| [' ' '\009' '\012' '\r']+	{ main lexbuf }
+
+| ['\n']	{ new_line lexbuf; main lexbuf}
+
+| "*/"		{ raise_syntax_error Unmatched_comment (lexeme_start_p lexbuf) }
+
+| "/*"		{ comment_depth := 1; comment_start := lexeme_start_p lexbuf;
+		  comment lexbuf; main lexbuf }
 
-| eof	{ EOF }
-| "="	{ EQUAL }
-| "*"	{ STAR }
-| ";"	{ SEMI }
-| ";;"	{ SEMISEMI }
-| ":"	{ COLON }
-| "|"	{ BAR }
-
-| "{"	{ LBRACE }
-| "}"	{ RBRACE }
-| "("	{ LPAREN }
-| ")"	{ RPAREN }
-| "["	{ LBRACK }
-| "]"	{ RBRACK }
+| eof		{ EOF }
+| "="		{ EQUAL }
+| "*"		{ STAR }
+| ";"		{ SEMI }
+| ";;"		{ SEMISEMI }
+| ":"		{ COLON }
+| "|"		{ BAR }
+
+| "{"		{ LBRACE }
+| "}"		{ RBRACE }
+| "("		{ LPAREN }
+| ")"		{ RPAREN }
+| "["		{ LBRACK }
+| "]"		{ RBRACK }
 
 | "type"	{ TYPE }
 | "and"		{ AND }
@@ -87,24 +81,12 @@ rule main = parse
 	  | 'a' .. 'z' -> LIDENT str
 	  | _ ->          raise_syntax_error (Invalid_ident str) (lexeme_start_p lexbuf)
 	}
-| _
-	{ raise_syntax_error (Illegal_character (lexeme_char lexbuf 0)) (lexeme_start_p lexbuf) }
+| _	{ raise_syntax_error (Illegal_character (lexeme_char lexbuf 0)) (lexeme_start_p lexbuf) }
 
 
 and comment = parse
-| "/*"
-	{ incr comment_depth;
-	  comment lexbuf
-	}
-| "*/"
-	{ decr comment_depth;
-	  if !comment_depth > 0 then comment lexbuf
-	}
-| ['\n']
-	{ new_line lexbuf;
-	  comment lexbuf
-	}
-| eof
-	{ raise_syntax_error Unterminated_comment !comment_start }
-| _
-	{ comment lexbuf }
+| "/*"		{ incr comment_depth; comment lexbuf }
+| "*/"		{ decr comment_depth; if !comment_depth > 0 then comment lexbuf	}
+| ['\n']	{ new_line lexbuf; comment lexbuf }
+| eof		{ raise_syntax_error Unterminated_comment !comment_start }
+| _		{ comment lexbuf }
diff --git a/libs/json/parser.mly b/libs/json/parser.mly
index f061234..95b9b80 100644
--- a/libs/json/parser.mly
+++ b/libs/json/parser.mly
@@ -39,68 +39,49 @@ let raise_syntax_error e pos =
 %%
 
 defn_list:
-| defns EOF
-	{ List.rev $1 }
+| defns EOF			{ List.rev $1 }
 ;
 
 defns:
-| defns top_defn_term
-	{ $2 :: $1 }
-| /* epsilon */
-	{ [] }
+| defns top_defn_term		{ $2 :: $1 }
+| /* epsilon */			{ [] }
 ;
 
 top_defn_term:
-| defn semi
-	{ $1 }
+| defn semi			{ $1 }
 
 defn:
-| TYPE eqn
-	{ [ $2 ] }
+| TYPE eqn			{ [ $2 ] }
 
-| TYPE eqn AND defn_parts
-	{ $2 :: (List.rev $4) }
+| TYPE eqn AND defn_parts	{ $2 :: (List.rev $4) }
 
 defn_parts:
-| defn_parts AND eqn
-	{ $3 :: $1 }
-| eqn
-	{ [ $1 ] }
+| defn_parts AND eqn		{ $3 :: $1 }
+| eqn				{ [ $1 ] }
 
 eqn:
-| LIDENT EQUAL repn
-	{ ($1, $3) }
+| LIDENT EQUAL repn		{ ($1, $3) }
 ;
 
 semi:
-| SEMISEMI
-	{}
-| /* epsilon */
-	{}
+| SEMISEMI			{}
+| /* epsilon */			{}
 
 repn:
-| expr_or_tuple
-	{ $1 }
-| record
-	{ C_record (List.rev $1) }
-| variant
-	{ C_variant (List.rev $1) }
+| expr_or_tuple			{ $1 }
+| record			{ C_record (List.rev $1) }
+| variant			{ C_variant (List.rev $1) }
 
 expr_or_tuple:
-| expr
-	{ $1 }
-| expr STAR tuple
-	{ C_tuple ($1 :: (List.rev $3)) }
+| expr				{ $1 }
+| expr STAR tuple		{ C_tuple ($1 :: (List.rev $3)) }
 
 tuple:
-| tuple STAR expr
-	{ $3 :: $1 }
-| expr
-	{ [ $1 ] }
+| tuple STAR expr		{ $3 :: $1 }
+| expr				{ [ $1 ] }
 
 expr:
-| LPAREN expr_or_tuple RPAREN
-	{ $2 }
+| LPAREN expr_or_tuple RPAREN	{ $2 }
 
 | expr LIDENT
 	{ match $2 with
@@ -111,8 +92,7 @@ expr:
 				(Unsupported_type_constructor s)
 				(Parsing.rhs_start_pos 2))
 	}
-| base
-	{ C_base $1 }
+| base				{ C_base $1 }
 
 base:
 | LIDENT	{ match $1 with
@@ -127,41 +107,28 @@ base:
 */
 
 record:
-| LBRACE field_decls opt_semi RBRACE
-	{ $2 }
+| LBRACE field_decls opt_semi RBRACE	{ $2 }
 
 field_decls:
-| field_decls SEMI field_decl
-	{ $3 :: $1 }
-| field_decl
-	{ [ $1 ] }
+| field_decls SEMI field_decl	{ $3 :: $1 }
+| field_decl			{ [ $1 ] }
 
 opt_semi:
-| SEMI
-	{}
-| /* epsilon */
-	{}
+| SEMI				{}
+| /* epsilon */			{}
 
 field_decl:
-| LIDENT COLON expr_or_tuple
-	{ ($1, $3) }
-| MUTABLE LIDENT COLON expr_or_tuple
-	{ ($2, $4) }
+| LIDENT COLON expr_or_tuple		{ ($1, $3) }
+| MUTABLE LIDENT COLON expr_or_tuple	{ ($2, $4) }
 
 variant:
-| variant BAR constr
-	{ $3 :: $1 }
-| constr
-	{ [ $1 ] }
-| /* epsilon */
-	{ [] }
+| variant BAR constr		{ $3 :: $1 }
+| constr			{ [ $1 ] }
+| /* epsilon */			{ [] }
 
 constr:
-| UIDENT
-	{ CD_tuple ($1, []) }
-| UIDENT OF expr
-	{ CD_tuple ($1, [ $3 ]) }
+| UIDENT			{ CD_tuple ($1, []) }
+| UIDENT OF expr		{ CD_tuple ($1, [ $3 ]) }
 
-| UIDENT OF expr STAR tuple
-	{ CD_tuple ($1, ($3 :: (List.rev $5))) }
+| UIDENT OF expr STAR tuple	{ CD_tuple ($1, ($3 :: (List.rev $5))) }