From 4b6b00930ffac028dc21f55bbff511b4aa63bcea Mon Sep 17 00:00:00 2001 From: Prashanth Mundkur Date: Thu, 2 Apr 2009 11:31:49 -0700 Subject: [PATCH] [json] add files for json<->ocaml converter --- libs/json/codegen.ml | 19 ++++++ libs/json/jsonc.ml | 79 ++++++++++++++++++++++ libs/json/lexer.mll | 122 ++++++++++++++++++++++++++++++++++ libs/json/parser.mly | 154 +++++++++++++++++++++++++++++++++++++++++++ libs/json/syntax.ml | 44 +++++++++++++ 5 files changed, 418 insertions(+) create mode 100644 libs/json/codegen.ml create mode 100644 libs/json/jsonc.ml create mode 100644 libs/json/lexer.mll create mode 100644 libs/json/parser.mly create mode 100644 libs/json/syntax.ml diff --git a/libs/json/codegen.ml b/libs/json/codegen.ml new file mode 100644 index 0000000..b8fa6fa --- /dev/null +++ b/libs/json/codegen.ml @@ -0,0 +1,19 @@ +(* + * Copyright (C) 2009 Citrix Ltd. + * Author Prashanth Mundkur + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published + * by the Free Software Foundation; version 2.1 only. with the special + * exception on linking described in file LICENSE. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + *) + +open Syntax + +let generate defn_list f = + Printf.printf "Generating conversions for %d definitions in %s.\n" (List.length defn_list) f diff --git a/libs/json/jsonc.ml b/libs/json/jsonc.ml new file mode 100644 index 0000000..266fd94 --- /dev/null +++ b/libs/json/jsonc.ml @@ -0,0 +1,79 @@ +(* + * Copyright (C) 2009 Citrix Ltd. + * Author Prashanth Mundkur + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published + * by the Free Software Foundation; version 2.1 only. with the special + * exception on linking described in file LICENSE. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + *) + +open Syntax +open Parser +open Lexing + +let show_syntax_error e l = + let loc = Printf.sprintf "%s at line %d, char %d" + l.pos_fname l.pos_lnum (l.pos_cnum - l.pos_bol) in + let msg = + match e with + | Illegal_character c -> Printf.sprintf "Illegal character %c" c + | Invalid_ident s -> Printf.sprintf "Invalid/unsupported identifier %s" s + | Unmatched_comment -> Printf.sprintf "Unmatched comment" + | Unterminated_comment -> Printf.sprintf "Unterminated comment" + in + Printf.printf "%s: %s\n" loc msg; + exit 1 + +let show_parse_error lexbuf = + let lxm = lexeme lexbuf in + let loc = Printf.sprintf "%s at line %d, char %d" + lexbuf.lex_curr_p.pos_fname lexbuf.lex_curr_p.pos_lnum + (lexbuf.lex_curr_p.pos_cnum - lexbuf.lex_curr_p.pos_bol) in + (match lxm with + | "" -> Printf.printf "%s: parsing error\n" loc + | _ -> Printf.printf "%s: parsing error at \"%s\"\n" loc lxm); + exit 1 + +let parse_file file = + let f = open_in file in + let lexbuf = Lexing.from_channel f in + try + Lexer.init lexbuf file; + Parser.defn_list Lexer.main lexbuf + with + | Syntax_error (e, l) -> + show_syntax_error e l + | Parsing.Parse_error -> + show_parse_error lexbuf + +let default_output_filename f = + let dir, base = Filename.dirname f, Filename.basename f in + 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 + + (* parse argv *) + let larg = [ + ("-i", Arg.Set_string input, "input file"); + ("-o", Arg.Set_string output, "output file"); + ] in + let usage_msg = Printf.sprintf "%s -i [-o ]" Sys.argv.(0) in + Arg.parse larg (fun s -> ()) usage_msg; + + if !output = "" then output := default_output_filename !input; + + match !input with + | "" -> Printf.printf "%s\n" usage_msg + | file -> gen_code (parse_file file) !output diff --git a/libs/json/lexer.mll b/libs/json/lexer.mll new file mode 100644 index 0000000..1ff38fb --- /dev/null +++ b/libs/json/lexer.mll @@ -0,0 +1,122 @@ +(* + * Copyright (C) 2009 Citrix Ltd. + * Author Prashanth Mundkur + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published + * by the Free Software Foundation; version 2.1 only. with the special + * exception on linking described in file LICENSE. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + *) + +{ + +open Lexing +open Syntax +open Parser + +let comment_depth = ref 0 +let comment_start = ref dummy_pos + +let line_num = ref 0 + +let init lexbuf fname = + lexbuf.lex_curr_p <- { pos_fname = fname; + pos_lnum = 1; + pos_bol = 0; + pos_cnum = 0 } + +let raise_syntax_error e loc = + raise (Syntax_error (e, loc)) + +} + +let letter = ['A'-'Z' 'a'-'z'] + +(* The handling of '.' is a bit of a hack for now; not sure if it's + really needed. *) +let ident_first = letter | '_' +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 + } + +| eof { EOF } +| "=" { EQUAL } +| "*" { STAR } +| ";" { SEMI } +| ";;" { SEMISEMI } +| ":" { COLON } +| "|" { BAR } + +| "{" { LBRACE } +| "}" { RBRACE } +| "(" { LPAREN } +| ")" { RPAREN } +| "[" { LBRACK } +| "]" { RBRACK } + +| "type" { TYPE } +| "and" { AND } +| "mutable" { MUTABLE } +| "of" { OF } + +(* hardcoded type constructors; this could be handled more + intelligently later. *) + +| "option" { OPTION } +| "list" { LIST } +| "array" { ARRAY } + +| "string" { STRING } +| "int" { INT } +| "Int64.t" { INT64 } +| "bool" { BOOL } + +(* general identifiers. we could handle the '.' here. *) +| ident + { let str = lexeme lexbuf in + match String.get str 0 with + | 'A' .. 'Z' -> UIDENT str + | '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) } + + +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 } diff --git a/libs/json/parser.mly b/libs/json/parser.mly new file mode 100644 index 0000000..fe92579 --- /dev/null +++ b/libs/json/parser.mly @@ -0,0 +1,154 @@ +/* + * Copyright (C) 2009 Citrix Ltd. + * Author Prashanth Mundkur + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published + * by the Free Software Foundation; version 2.1 only. with the special + * exception on linking described in file LICENSE. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + */ + + +%{ + +open Syntax + +let raise_syntax_error e pos = + raise (Syntax_error (e, pos)) + +%} + +/* keywords */ +%token TYPE AND MUTABLE OF +%token OPTION LIST ARRAY STRING INT INT64 BOOL + +%token LBRACE RBRACE LPAREN RPAREN LBRACK RBRACK +%token EQUAL STAR SEMI SEMISEMI COLON BAR +%token EOF + +%token UIDENT LIDENT + +%start defn_list + +%type defn_list + +%% + +defn_list: +| defns EOF + { List.rev $1 } +; + +defns: +| defns top_defn_term + { $2 :: $1 } +| /* epsilon */ + { [] } +; + +top_defn_term: +| defn semi + { $1 } + +defn: +| TYPE eqn + { [ $2 ] } + +| TYPE eqn AND defn_parts + { $2 :: (List.rev $4) } + +defn_parts: +| defn_parts AND eqn + { $3 :: $1 } +| eqn + { [ $1 ] } + +eqn: +| LIDENT EQUAL repn + { ($1, $3) } +; + +semi: +| SEMISEMI + {} +| /* epsilon */ + {} + +repn: +| expr + { $1 } +| expr STAR tuple + { C_prod ($1 :: (List.rev $3)) } +| record + { C_record (List.rev $1) } +| variant + { C_variant (List.rev $1) } + +expr: +| LPAREN expr RPAREN + { $2 } +| LPAREN expr STAR tuple RPAREN + { C_prod ($2 :: (List.rev $4)) } +| expr OPTION + { C_option $1 } +| expr LIST + { C_list $1 } +| expr ARRAY + { C_array $1 } +| base + { C_base $1 } + +tuple: +| tuple STAR expr + { $3 :: $1 } +| expr + { [ $1 ] } + +base: +| STRING { B_string } +| INT { B_int } +| INT64 { B_int64 } +| BOOL { B_bool } +| LIDENT { B_ident $1 } +/* TODO: +| UIDENT { raise_syntax_error (Invalid_ident $1) } +*/ + +record: +| LBRACE field_decls RBRACE + { $2 } + +field_decls: +| field_decls SEMI field_decl + { $3 :: $1 } +| /* epsilon */ + { [] } + +field_decl: +| LIDENT COLON expr + { ($1, $3) } +| MUTABLE LIDENT COLON expr + { ($2, $4) } + +variant: +| variant BAR constr + { $3 :: $1 } +| constr + { [ $1 ] } +| /* epsilon */ + { [] } + +constr: +| UIDENT + { CD_prod ($1, []) } +| UIDENT OF expr + { CD_prod ($1, [ $3 ]) } + +| UIDENT OF expr STAR tuple + { CD_prod ($1, ($3 :: (List.rev $5))) } + diff --git a/libs/json/syntax.ml b/libs/json/syntax.ml new file mode 100644 index 0000000..79bce1b --- /dev/null +++ b/libs/json/syntax.ml @@ -0,0 +1,44 @@ +(* + * Copyright (C) 2009 Citrix Ltd. + * Author Prashanth Mundkur + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published + * by the Free Software Foundation; version 2.1 only. with the special + * exception on linking described in file LICENSE. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + *) + +type syntax_error = + | Illegal_character of char + | Invalid_ident of string + | Unmatched_comment + | Unterminated_comment + +exception Syntax_error of syntax_error * Lexing.position + +type base_type = + | B_string + | B_int + | B_int64 + | B_bool + | B_ident of string + +type complex_type = + | C_base of base_type + | C_option of complex_type + | C_list of complex_type + | C_array of complex_type + | C_prod of complex_type list + | C_record of (string * complex_type) list + | C_variant of constr_decl list + +and constr_decl = + | CD_prod of string * complex_type list + +type type_defn = (string * complex_type) list + -- 2.39.5