fix option_of_json; some cleanup

diff --git a/libs/json/codegen.ml b/libs/json/codegen.ml
index 77dec510c403c6b255c16d35dea48c60ea85b13e..b7a01221fad0835249a5b22f26e1e9057b893876 100644 (file)
--- 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 74def13e2d4726f87cb2bb5b93e5af141dcbe430..0407684101b1bdb39cd414fc8af57af900fc1ded 100644 (file)
--- 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 f0612344e542403a0284480256b5a0b6f5332f67..95b9b80d88d5b0fc65884673c0df56f2a527bd3c 100644 (file)
--- 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))) }