瀏覽代碼

[cs] added debug flag and optimized code generation

Caue Waneck 13 年之前
父節點
當前提交
23ec33f61a
共有 3 個文件被更改,包括 50 次插入27 次删除
  1. 18 12
      gencommon.ml
  2. 29 13
      gencs.ml
  3. 3 2
      genjava.ml

+ 18 - 12
gencommon.ml

@@ -162,6 +162,7 @@ rules were devised:
 let assertions = false (* when assertions == true, many assertions will be made to guarantee the quality of the data input *)
 let assertions = false (* when assertions == true, many assertions will be made to guarantee the quality of the data input *)
 let debug_mode = ref false
 let debug_mode = ref false
 let trace s = if !debug_mode then print_endline s else ()
 let trace s = if !debug_mode then print_endline s else ()
+let timer name = if !debug_mode then Common.timer name else fun () -> ()
 
 
 (* helper function for creating Anon types of class / enum modules *)
 (* helper function for creating Anon types of class / enum modules *)
 
 
@@ -254,7 +255,7 @@ struct
 
 
   let new_source_writer () =
   let new_source_writer () =
     {
     {
-      sw_buf = Buffer.create 100;
+      sw_buf = Buffer.create (1 lsl 14);
       sw_has_content = false;
       sw_has_content = false;
       sw_indent = "";
       sw_indent = "";
       sw_indents = [];
       sw_indents = [];
@@ -263,9 +264,11 @@ struct
   let contents w = Buffer.contents w.sw_buf
   let contents w = Buffer.contents w.sw_buf
   
   
   let write w x =
   let write w x =
+    let t = timer "write contents" in
     (if not w.sw_has_content then begin w.sw_has_content <- true; Buffer.add_string w.sw_buf w.sw_indent; Buffer.add_string w.sw_buf x; end else Buffer.add_string w.sw_buf x);
     (if not w.sw_has_content then begin w.sw_has_content <- true; Buffer.add_string w.sw_buf w.sw_indent; Buffer.add_string w.sw_buf x; end else Buffer.add_string w.sw_buf x);
     let len = (String.length x)-1 in
     let len = (String.length x)-1 in
-    if len >= 0 && String.get x len = '\n' then begin w.sw_has_content <- false end else w.sw_has_content <- true
+    if len >= 0 && String.get x len = '\n' then begin w.sw_has_content <- false end else w.sw_has_content <- true;
+    t()
 
 
   let push_indent w = w.sw_indents <- "\t"::w.sw_indents; w.sw_indent <- String.concat "" w.sw_indents
   let push_indent w = w.sw_indents <- "\t"::w.sw_indents; w.sw_indent <- String.concat "" w.sw_indents
 
 
@@ -280,7 +283,9 @@ struct
 
 
   let end_block w = pop_indent w; (if w.sw_has_content then newline w); write w "}"; newline w
   let end_block w = pop_indent w; (if w.sw_has_content then newline w); write w "}"; newline w
 
 
-  let print w = (if not w.sw_has_content then begin w.sw_has_content <- true; Buffer.add_string w.sw_buf w.sw_indent end); bprintf w.sw_buf
+  let print w = 
+    (if not w.sw_has_content then begin w.sw_has_content <- true; Buffer.add_string w.sw_buf w.sw_indent end);
+    bprintf w.sw_buf;
   
   
 end;;
 end;;
 
 
@@ -864,14 +869,14 @@ let run_filters gen =
   gen.gcon.types <- run_filters gen.gsyntax_filters;
   gen.gcon.types <- run_filters gen.gsyntax_filters;
   List.iter (fun fn -> fn()) gen.gafter_filters_ended;
   List.iter (fun fn -> fn()) gen.gafter_filters_ended;
   
   
-  reorder_modules gen;
-  debug_mode := false
+  reorder_modules gen
 
 
 (* ******************************************* *)
 (* ******************************************* *)
 (* basic generation module that source code compilation implementations can use *)
 (* basic generation module that source code compilation implementations can use *)
 (* ******************************************* *)
 (* ******************************************* *)
 
 
 let write_file gen w source_dir path extension = 
 let write_file gen w source_dir path extension = 
+  let t = timer "write file" in
   let s_path = gen.gcon.file ^ "/" ^  source_dir  ^ "/" ^ (String.concat "/" (fst path)) ^ "/" ^ (snd path) ^ "." ^ (extension) in
   let s_path = gen.gcon.file ^ "/" ^  source_dir  ^ "/" ^ (String.concat "/" (fst path)) ^ "/" ^ (snd path) ^ "." ^ (extension) in
   (* create the folders if they don't exist *)
   (* create the folders if they don't exist *)
   let rec create acc = function
   let rec create acc = function
@@ -885,7 +890,7 @@ let write_file gen w source_dir path extension =
   create [] p;
   create [] p;
   
   
   let contents = SourceWriter.contents w in
   let contents = SourceWriter.contents w in
-  let should_write = if Sys.file_exists s_path then begin
+  let should_write = if not (Common.defined gen.gcon "replace_files") && Sys.file_exists s_path then begin
     let in_file = open_in s_path in
     let in_file = open_in s_path in
     let old_contents = Std.input_all in_file in
     let old_contents = Std.input_all in_file in
     close_in in_file;
     close_in in_file;
@@ -896,7 +901,8 @@ let write_file gen w source_dir path extension =
     let f = open_out s_path in
     let f = open_out s_path in
     output_string f contents;
     output_string f contents;
     close_out f
     close_out f
-  end
+  end;
+  t()
 
 
 (*
 (*
   helper function to create the source structure. Will send each module_def to the function passed.
   helper function to create the source structure. Will send each module_def to the function passed.
@@ -8263,7 +8269,7 @@ end;;
 
 
 (*
 (*
   
   
-  In some source code platforms, the code won't compile if there is unreacheable code, so this filter will take off any unreachable code.
+  In some source code platforms, the code won't compile if there is Unreachable code, so this filter will take off any unreachable code.
     If the parameter "handle_switch_break" is set to true, it will already add a "break" statement on switch cases when suitable;
     If the parameter "handle_switch_break" is set to true, it will already add a "break" statement on switch cases when suitable;
       in order to not confuse with while break, it will be a special expression __sbreak__
       in order to not confuse with while break, it will be a special expression __sbreak__
     If the parameter "handle_not_final_returns" is set to true, it will also add final returns when functions are detected to be lacking of them.
     If the parameter "handle_not_final_returns" is set to true, it will also add final returns when functions are detected to be lacking of them.
@@ -8298,7 +8304,7 @@ struct
     let basic = gen.gcon.basic in
     let basic = gen.gcon.basic in
     
     
     let do_warn =
     let do_warn =
-      if should_warn then gen.gcon.warning "Unreacheable code" else (fun pos -> ())
+      if should_warn then gen.gcon.warning "Unreachable code" else (fun pos -> ())
     in
     in
     
     
     let return_loop expr kind =
     let return_loop expr kind =
@@ -8338,11 +8344,11 @@ struct
         
         
         | TBlock bl ->
         | TBlock bl ->
           let new_block = ref [] in
           let new_block = ref [] in
-          let is_unreacheable = ref false in
+          let is_Unreachable = ref false in
           let ret_kind = ref Normal in
           let ret_kind = ref Normal in
           
           
           List.iter (fun e ->
           List.iter (fun e ->
-            if !is_unreacheable then
+            if !is_Unreachable then
               do_warn e.epos 
               do_warn e.epos 
             else begin
             else begin
               let changed_e, kind = process_expr e in
               let changed_e, kind = process_expr e in
@@ -8350,7 +8356,7 @@ struct
               match kind with
               match kind with
                 | BreaksLoop | BreaksFunction -> 
                 | BreaksLoop | BreaksFunction -> 
                   ret_kind := kind;
                   ret_kind := kind;
-                  is_unreacheable := true
+                  is_Unreachable := true
                 | _ -> ()
                 | _ -> ()
             end
             end
           ) bl;
           ) bl;

+ 29 - 13
gencs.ml

@@ -522,7 +522,7 @@ let configure gen =
   
   
   let rec real_type t =
   let rec real_type t =
     let t = gen.gfollow#run_f t in
     let t = gen.gfollow#run_f t in
-    match t with
+    let ret = match t with
       | TInst( { cl_path = (["haxe"], "Int32") }, [] ) -> gen.gcon.basic.tint
       | TInst( { cl_path = (["haxe"], "Int32") }, [] ) -> gen.gcon.basic.tint
       | TInst( { cl_path = (["haxe"], "Int64") }, [] ) -> ti64
       | TInst( { cl_path = (["haxe"], "Int64") }, [] ) -> ti64
       | TEnum(_, [])
       | TEnum(_, [])
@@ -553,6 +553,8 @@ let configure gen =
       | TAnon _ -> dynamic_anon
       | TAnon _ -> dynamic_anon
       | TFun _ -> TInst(fn_cl,[])
       | TFun _ -> TInst(fn_cl,[])
       | _ -> t_dynamic
       | _ -> t_dynamic
+    in
+    ret
   and
   and
   
   
   (* 
   (* 
@@ -694,25 +696,31 @@ let configure gen =
     let rec expr_s w e =
     let rec expr_s w e =
       let was_in_value = !in_value in
       let was_in_value = !in_value in
       in_value := true;
       in_value := true;
-      match e.eexpr with
+      (match e.eexpr with
         | TConst c ->
         | TConst c ->
           (match c with
           (match c with
             | TInt i32 -> 
             | TInt i32 -> 
-              print w "%ld" i32;
-              (match real_type e.etype with
+              write w (Int32.to_string i32);
+              (*match real_type e.etype with
                 | TType( { t_path = ([], "Int64") }, [] ) -> write w "L";
                 | TType( { t_path = ([], "Int64") }, [] ) -> write w "L";
                 | _ -> ()
                 | _ -> ()
-              )
+              *)
             | TFloat s -> 
             | TFloat s -> 
               write w s;
               write w s;
               (if String.get s (String.length s - 1) = '.' then write w "0");
               (if String.get s (String.length s - 1) = '.' then write w "0");
-              (match real_type e.etype with
+              (*match real_type e.etype with
                 | TType( { t_path = ([], "Single") }, [] ) -> write w "f"
                 | TType( { t_path = ([], "Single") }, [] ) -> write w "f"
                 | _ -> ()
                 | _ -> ()
-              )
-            | TString s -> print w "\"%s\"" (escape s)
+              *)
+            | TString s -> 
+              write w "\"";
+              write w (escape s);
+              write w "\""
             | TBool b -> write w (if b then "true" else "false")
             | TBool b -> write w (if b then "true" else "false")
-            | TNull -> print w "default(%s)" (t_s e.etype)
+            | TNull -> 
+              write w "default(";
+              write w (t_s e.etype);
+              write w ")"
             | TThis -> write w "this"
             | TThis -> write w "this"
             | TSuper -> write w "base")
             | TSuper -> write w "base")
         | TLocal { v_name = "__sbreak__" } -> write w "break"
         | TLocal { v_name = "__sbreak__" } -> write w "break"
@@ -854,15 +862,20 @@ let configure gen =
           expr_s w e
           expr_s w e
         | TBlock el ->
         | TBlock el ->
           begin_block w;
           begin_block w;
+          (*
+            Line directives are turned off right now because:
+              1 - It makes harder to debug when the generated code internals are the problem
+              2 - Lexer.get_error_line is a very expensive operation
           let last_line = ref (-1) in
           let last_line = ref (-1) in
           let line_directive p =
           let line_directive p =
             let cur_line = Lexer.get_error_line p in
             let cur_line = Lexer.get_error_line p in
             let is_relative_path = (String.sub p.pfile 0 1) = "." in
             let is_relative_path = (String.sub p.pfile 0 1) = "." in
             let file = if is_relative_path then "../" ^ p.pfile else p.pfile in
             let file = if is_relative_path then "../" ^ p.pfile else p.pfile in
             if cur_line <> ((!last_line)+1) then begin print w "//#line %d \"%s\"" cur_line (Ast.s_escape file); newline w end;
             if cur_line <> ((!last_line)+1) then begin print w "//#line %d \"%s\"" cur_line (Ast.s_escape file); newline w end;
-            last_line := cur_line in
+            last_line := cur_line 
+          in *)
           List.iter (fun e -> 
           List.iter (fun e -> 
-            line_directive e.epos;
+            (*line_directive e.epos;*)
             in_value := false;
             in_value := false;
             expr_s w e;
             expr_s w e;
             (if has_semicolon e then write w ";");
             (if has_semicolon e then write w ";");
@@ -969,6 +982,7 @@ let configure gen =
         | TObjectDecl _ -> write w "[ obj decl not supported ]"; if !strict_mode then assert false
         | TObjectDecl _ -> write w "[ obj decl not supported ]"; if !strict_mode then assert false
         | TFunction _ -> write w "[ func decl not supported ]"; if !strict_mode then assert false
         | TFunction _ -> write w "[ func decl not supported ]"; if !strict_mode then assert false
         | TMatch _ -> write w "[ match not supported ]"; if !strict_mode then assert false
         | TMatch _ -> write w "[ match not supported ]"; if !strict_mode then assert false
+    )
     in
     in
     expr_s w e
     expr_s w e
   in
   in
@@ -1085,7 +1099,7 @@ let configure gen =
           
           
         end);
         end);
       newline w;
       newline w;
-      newline w
+      newline w;
   in
   in
   
   
   let check_special_behaviors w cl =
   let check_special_behaviors w cl =
@@ -1243,6 +1257,7 @@ let configure gen =
     List.iter (gen_class_field w false cl is_final) cl.cl_ordered_fields;
     List.iter (gen_class_field w false cl is_final) cl.cl_ordered_fields;
     check_special_behaviors w cl;
     check_special_behaviors w cl;
     end_block w;
     end_block w;
+    
     if should_close then end_block w
     if should_close then end_block w
   in
   in
     
     
@@ -1722,5 +1737,6 @@ let before_generate con =
 
 
 let generate con =
 let generate con =
   let gen = new_ctx con in
   let gen = new_ctx con in
-  configure gen
+  configure gen;
+  debug_mode := false
   
   

+ 3 - 2
genjava.ml

@@ -1784,6 +1784,7 @@ let generate con =
   ] in
   ] in
   List.iter (fun cf -> gen.gbase_class_fields <- PMap.add cf.cf_name cf gen.gbase_class_fields) basic_fns;
   List.iter (fun cf -> gen.gbase_class_fields <- PMap.add cf.cf_name cf gen.gbase_class_fields) basic_fns;
   
   
-  try
+  (try
     configure gen
     configure gen
-  with | TypeNotFound path -> con.error ("Error. Module '" ^ (path_s path) ^ "' is required and was not included in build.")  Ast.null_pos
+  with | TypeNotFound path -> con.error ("Error. Module '" ^ (path_s path) ^ "' is required and was not included in build.")  Ast.null_pos);
+  debug_mode := false