diff --git a/generator/js_of_ast.ml b/generator/js_of_ast.ml
index 44d752aef9e3fe82ec9273e5f73d94672efb7f20..9787d33271e56ce5b00130161fa6c18a5df34a0d 100644
--- a/generator/js_of_ast.ml
+++ b/generator/js_of_ast.ml
@@ -4,7 +4,6 @@ open Attributes
open Log
open Misc
open Mytools
-open Parse_type
open Types
open Typedtree
diff --git a/generator/main.ml b/generator/main.ml
index 69d04533fc3a5c68e1fa27d48116563f18259726..e507a899ddfb336d2651e5deee812f7fb0b5d8d1 100644
--- a/generator/main.ml
+++ b/generator/main.ml
@@ -2,7 +2,6 @@
open Params
open Format
open Mytools
-open Parse_type
(*
Remark: field name attributes for builtins (eg: ::) are defined in attributes.ml
@@ -24,6 +23,42 @@ let add_to_list li s =
li := s :: !li
+let tool_name = "ml2js"
+
+let init_path () =
+ Config.load_path :=
+ "stdlib_ml" :: List.rev (Config.standard_library :: !Clflags.include_dirs);
+ Env.reset_cache ()
+
+(** Return the initial environment in which compilation proceeds. *)
+
+let initial_env () =
+ try
+ let env = Env.initial_unsafe_string in
+ Env.open_pers_signature "Stdlib" env
+ with Not_found ->
+ Misc.fatal_error "cannot open stdlib"
+
+(** Analysis of an implementation file. Returns (Some typedtree) if
+ no error occured, else None and an error message is printed.*)
+let process_implementation_file ppf sourcefile =
+ init_path ();
+ let oprefix = Compenv.output_prefix sourcefile in
+ let modulename = Compenv.module_of_filename ppf sourcefile oprefix in
+ Env.set_unit_name modulename;
+ let env = initial_env () in
+ try
+ let parsetree = Pparse.parse_implementation ~tool_name ppf sourcefile in
+ if !Clflags.dump_source then fprintf ppf "%a@." Pprintast.structure parsetree;
+ let typing = Typemod.type_implementation sourcefile oprefix modulename env parsetree in
+ (parsetree, typing, modulename)
+ with e ->
+ Location.report_exception ppf e;
+ exit 2
+
+
+
+
let _ =
(*---------------------------------------------------*)
(* parsing of command line *)
@@ -51,6 +86,7 @@ let _ =
let basename = Filename.chop_suffix (Filename.basename sourcefile) ".ml" in
let dirname = Filename.dirname sourcefile in
let pathname = if dirname = "" then basename else (dirname ^ "/" ^ basename) in
+ (* Could use Clflags.output_name and Compenv.output_prefix? *)
let log_output, unlog_output, token_output, pseudo_output, ptoken_output, mlloc_output =
match !outputfile with
| None -> Filename.concat dirname (basename ^ ".log.js"),
@@ -97,28 +133,22 @@ let _ =
(*---------------------------------------------------*)
(* "reading and typing source file" *)
- let (opt, _, module_name) = process_implementation_file ppf sourcefile in
- let ((parsetree1 : Parsetree.structure), typedtree1) =
- match opt with
- | None -> failwith "Could not read and typecheck input file"
- | Some (parsetree1, (typedtree1,_)) -> parsetree1, typedtree1
- in
-
- match !current_mode with
- | Mode_cmi -> Printf.printf "Wrote %s.cmi\n" pathname
- | _ ->
- let out = Js_of_ast.to_javascript basename module_name typedtree1 in
- let output_filename = match !current_mode with
- | Mode_unlogged TokenTrue -> token_output
- | Mode_unlogged TokenFalse -> unlog_output
- | Mode_pseudo TokenTrue -> ptoken_output
- | Mode_pseudo TokenFalse -> pseudo_output
- | Mode_logged -> log_output
- | _ -> assert false
- in
- file_put_contents output_filename out;
- Printf.printf "Wrote %s\n" output_filename;
- if !current_mode = (Mode_unlogged TokenTrue)
- then generate_mlloc_file()
+ let (parsetree, (typedtree,_), module_name) = process_implementation_file ppf sourcefile in
+ match !current_mode with
+ | Mode_cmi -> Printf.printf "Wrote %s.cmi\n" pathname
+ | _ ->
+ let out = Js_of_ast.to_javascript basename module_name typedtree in
+ let output_filename = match !current_mode with
+ | Mode_unlogged TokenTrue -> token_output
+ | Mode_unlogged TokenFalse -> unlog_output
+ | Mode_pseudo TokenTrue -> ptoken_output
+ | Mode_pseudo TokenFalse -> pseudo_output
+ | Mode_logged -> log_output
+ | _ -> assert false
+ in
+ file_put_contents output_filename out;
+ Printf.printf "Wrote %s\n" output_filename;
+ if !current_mode = (Mode_unlogged TokenTrue)
+ then generate_mlloc_file()
diff --git a/generator/parse_type.ml b/generator/parse_type.ml
deleted file mode 100644
index f423a9a51e9375f6f513a9cbc81c8c6d095532c3..0000000000000000000000000000000000000000
--- a/generator/parse_type.ml
+++ /dev/null
@@ -1,257 +0,0 @@
-open Config
-open Clflags
-open Misc
-open Format
-open Typedtree
-
-(** The purpose of this file is to parse an interface file.
- The content of this file is a copy-pasting from the source
- code of OCamldoc. *)
-
-(*#########################################################################*)
-(* ** Parsing of MLI files *)
-
-(** Initialize the search path.
- The current directory is always searched first,
- then the directories specified with the -I option (in command-line order),
- then the standard library directory. *)
-
-let init_path () =
- load_path :=
- "stdlib_ml" :: List.rev (Config.standard_library :: !Clflags.include_dirs);
- Env.reset_cache ()
-
-(** Return the initial environment in which compilation proceeds. *)
-
-let initial_env () =
- try
- let env = Env.initial_unsafe_string in
- Env.open_pers_signature "Stdlib" env
- with Not_found ->
- fatal_error "cannot open stdlib"
-
-(** Optionally preprocess a source file *)
-let preprocess sourcefile =
- match !Clflags.preprocessor with
- None -> sourcefile
- | Some pp ->
- let tmpfile = Filename.temp_file "camlpp" "" in
- let comm = Printf.sprintf "%s %s > %s" pp sourcefile tmpfile in
- if Ccomp.command comm <> 0 then begin
- remove_file tmpfile;
- Printf.eprintf "Preprocessing error\n";
- exit 2
- end;
- tmpfile
-
-(** Remove the input file if this file was the result of a preprocessing.*)
-let remove_preprocessed inputfile =
- match !Clflags.preprocessor with
- None -> ()
- | Some _ -> remove_file inputfile
-
-let remove_preprocessed_if_ast inputfile =
- match !Clflags.preprocessor with
- None -> ()
- | Some _ -> if inputfile <> !Location.input_name then remove_file inputfile
-
-exception Outdated_version
-
-(** Parse a file or get a dumped syntax tree in it *)
-let parse_file inputfile parse_fun ast_magic =
-(* TODO new version is:
- let (ic, is_ast_file) = open_and_check_magic inputfile ast_magic in *)
- let ic = open_in_bin inputfile in
- let is_ast_file =
- try
- let buffer = String.create (String.length ast_magic) in
- really_input ic buffer 0 (String.length ast_magic);
- if buffer = ast_magic then true
- else if String.sub buffer 0 9 = String.sub ast_magic 0 9 then
- raise Outdated_version
- else false
- with
- Outdated_version ->
- fatal_error "Ocaml and preprocessor have incompatible versions"
- | _ -> false
- in
- let ast =
- try
- if is_ast_file then begin
- Location.input_name := input_value ic;
- input_value ic
- end else begin
- seek_in ic 0;
- Location.input_name := inputfile;
- let lexbuf = Lexing.from_channel ic in
- Location.init lexbuf inputfile;
- parse_fun lexbuf
- end
- with x -> close_in ic; raise x
- in
- close_in ic;
- (* was: ast *)
- Pparse.apply_rewriters ~restore:false ~tool_name:"ok" ast_magic ast
-
-
-
-(** Analysis of an implementation file. Returns (Some typedtree) if
- no error occured, else None and an error message is printed.*)
-let process_implementation_file ppf sourcefile =
-
- init_path ();
- let prefixname = Filename.chop_extension sourcefile in
- let modulename = String.capitalize(Filename.basename prefixname) in
- Env.set_unit_name modulename;
- let inputfile = preprocess sourcefile in
- try
- let env = initial_env () in
- let parsetree = parse_file inputfile Parse.implementation ast_impl_magic_number in
- if !Clflags.dump_source then fprintf ppf "%a@." Pprintast.structure parsetree;
-
- let typedtree = Typemod.type_implementation sourcefile prefixname modulename env parsetree in
- (Some (parsetree, typedtree), inputfile, modulename)
- with
- e ->
- match e with
- Syntaxerr.Error err ->
- fprintf Format.err_formatter "@[%a@]@."
- Syntaxerr.report_error err;
- None, inputfile, modulename
- | Failure s ->
- prerr_endline s;
- (*incr Odoc_global.errors ;*)
- None, inputfile, modulename
- (* ADDED *)
- | Env.Error err ->
- Env.report_error ppf err;
- print_newline();
- raise e
- | Typecore.Error (loc,env,err) ->
- Location.print_error ppf loc;
- Typecore.report_error env ppf err;
- print_newline();
- raise e
- | Typetexp.Error (loc,env,err) ->
- Location.print_error ppf loc;
- Typetexp.report_error env ppf err;
- print_newline();
- raise e
- | Typemod.Error (loc,env,err) ->
- Location.print_error ppf loc;
- Typemod.report_error env ppf err;
- print_newline();
- raise e
- | e ->
- raise e
-
-(** Analysis of an interface file. Returns (Some signature) if
- no error occured, else None and an error message is printed.
-let process_interface_file ppf sourcefile =
- init_path ();
- let prefixname = Filename.chop_extension sourcefile in
- let modulename = String.capitalize(Filename.basename prefixname) in
- Env.set_unit_name modulename;
- let inputfile = preprocess sourcefile in
- let ast = parse_file inputfile Parse.interface ast_intf_magic_number in
- let sg = Typemod.transl_signature (initial_env()) ast in
- Warnings.check_fatal ();
- (ast, sg, inputfile)
-*)
-
-(*#########################################################################*)
-(* added *)
-
-let typecheck_implementation_file ppf sourcefile parsetree =
- init_path ();
- let prefixname = Filename.chop_extension sourcefile in
- let modulename = String.capitalize(Filename.basename prefixname) in
- Env.set_unit_name modulename;
- (* let inputfile = preprocess sourcefile in*)
- let env = initial_env () in
- try
- (* let parsetree = parse_file inputfile Parse.implementation ast_impl_magic_number in *)
- let typedtree = Typemod.type_implementation sourcefile prefixname modulename env parsetree in
- Some typedtree
- with
- e -> (* todo: factorize with above *)
- match e with
- Syntaxerr.Error err ->
- fprintf Format.err_formatter "@[%a@]@."
- Syntaxerr.report_error err;
- None
- | Failure s ->
- prerr_endline s;
- (*incr Odoc_global.errors ;*)
- None
- | Env.Error err ->
- Env.report_error ppf err;
- print_newline();
- raise e
- | Typetexp.Error (loc,env,err) ->
- Location.print_error ppf loc;
- Typetexp.report_error env ppf err;
- print_newline();
- raise e
- | Typecore.Error (loc,env,err) ->
- Location.print_error ppf loc;
- Typecore.report_error env ppf err;
- print_newline();
- raise e
- | Typemod.Error (loc,env,err) ->
- Location.print_error ppf loc;
- Typemod.report_error env ppf err;
- print_newline();
- raise e
- | e ->
- raise e
-
-
-let typecheck_interface_file ppf sourcefile output_prefix =
- init_path ();
- let prefixname = Filename.chop_extension sourcefile in
- let modulename = String.capitalize(Filename.basename prefixname) in
- Env.set_unit_name modulename;
- let inputfile = preprocess sourcefile in
- let ast = parse_file inputfile Parse.interface ast_intf_magic_number in
- let sg_opt = try
- let sg = Typemod.transl_signature (initial_env()) ast in
- Warnings.check_fatal ();
- Some sg
- with
- e -> (* todo: factorize with above *)
- match e with
- Syntaxerr.Error err ->
- fprintf Format.err_formatter "@[%a@]@."
- Syntaxerr.report_error err;
- None
- | Failure s ->
- prerr_endline s;
- (*incr Odoc_global.errors ;*)
- None
- | Env.Error err ->
- Env.report_error ppf err;
- print_newline();
- raise e
- | Typetexp.Error (loc,env,err) ->
- Location.print_error ppf loc;
- Typetexp.report_error env ppf err;
- print_newline();
- raise e
- | Typecore.Error (loc,env,err) ->
- Location.print_error ppf loc;
- Typecore.report_error env ppf err;
- print_newline();
- raise e
- | Typemod.Error (loc,env,err) ->
- Location.print_error ppf loc;
- Typemod.report_error env ppf err;
- print_newline();
- raise e
- | e ->
- raise e
- in
- match sg_opt with
- | None -> failwith "could not typecheck"
- | Some sg -> Env.save_signature sg.sig_type modulename (output_prefix ^ ".cmi")
-