Merge pull request #4156 from BuckleScript/fix_4152

fix #4152

Author: bobzhang

jscomp/core/classify_function.ml

@@ -22,7 +22,7 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
-let classify (prog : string) : Js_raw_exp_info.t = 
+let classify (prog : string) : Js_raw_info.exp = 
   match Parser_flow.parse_expression 
     (Parser_env.init_env None prog) false with 
   | (_, Function {
@@ -45,9 +45,16 @@ let classify (prog : string) : Js_raw_exp_info.t =
  |(_, Literal _), [] -> 
   Js_literal     
  | _ -> 
-  Js_unknown
+  Js_exp_unknown
  | exception _ -> 
-  Js_unknown
+  Js_exp_unknown
+
+let classify_stmt (prog : string) : Js_raw_info.stmt = 
+  let result =  Parser_flow.parse_program false None prog in 
+  match fst result with 
+  | (_loc, [], _) -> 
+    Js_stmt_comment 
+  | _ -> Js_stmt_unknown
 (* we can also analayze throw
   x.x pure access
  *)

jscomp/core/classify_function.mli

@@ -24,4 +24,7 @@
 
 
 val classify :
-  string -> Js_raw_exp_info.t 
+  string -> Js_raw_info.exp 
+
+val classify_stmt :  
+  string -> Js_raw_info.stmt

jscomp/core/j.ml

@@ -60,7 +60,7 @@ and tag_info = Js_op.tag_info
 
 and required_modules = Js_op.required_modules
 
-and code_info = Js_op.code_info 
+
 
 
 (** object literal, if key is ident, in this case, it might be renamed by 
@@ -168,7 +168,7 @@ and expression_desc =
      *)
   | Unicode of string 
     (* It is escaped string, print delimited by '"'*)   
-  | Raw_js_code of string * code_info
+  | Raw_js_code of Js_raw_info.t
   | Raw_js_function of string * string list
   (* literally raw JS code 
   *)

jscomp/core/js_dump.ml

@@ -169,12 +169,12 @@ let exp_need_paren  (e : J.expression) =
   (* | Caml_uninitialized_obj _  *)
   | Call ({expression_desc = Fun _ | Raw_js_function _ | Raw_js_code _ },_,_) -> true
 
-  | Raw_js_code (_, Exp _)
+  | Raw_js_code {code_info = Exp _}
   | Fun _ 
   | Raw_js_function _ 
   | Caml_block (_,_,_, (Blk_record _ | Blk_module _))
   | Object _ -> true
-  | Raw_js_code (_,Stmt)
+  | Raw_js_code {code_info = Stmt _ }
   | Length _
   | Call _
   | Caml_block_tag _
@@ -646,8 +646,7 @@ and expression_desc cxt ~(level:int) f x : cxt  =
     P.space f ; 
     pp_js_function_params_body f s params;
     cxt 
-  | Raw_js_code (s,info) ->
-    let s = String.trim s in             
+  | Raw_js_code {code = s; code_info = info} ->
     (match info with
      | Exp exp_info ->
        let raw_paren =
@@ -656,10 +655,11 @@ and expression_desc cxt ~(level:int) f x : cxt  =
        P.string f s ;       
        if raw_paren then  P.string f L.rparen;
        cxt
-     | Stmt ->
-       P.newline f  ;
+     | Stmt stmt_info ->
+       if stmt_info = Js_stmt_comment then P.string f s 
+       else begin P.newline f  ;
        P.string f s ;
-       P.newline f ;
+       P.newline f end ;
        cxt)
 
   | Number v ->
@@ -1051,16 +1051,23 @@ and statement_desc top cxt f (s : J.statement_desc) : cxt =
     cxt
   | Exp {expression_desc = Var _;}
     -> (* Does it make sense to optimize here? *)
-    semi f; cxt
-  | Exp e ->
-    let cxt =
-      (
-        if exp_need_paren  e
-        then P.paren_group f 1
-        else P.group f 0
-      ) (fun _ -> expression ~level:0 cxt f e ) in
-    semi f;
+    (* semi f; *)
     cxt
+  | Exp e ->
+    (
+      match e.expression_desc with 
+      | Raw_js_code {code = s; code_info =  Stmt (Js_stmt_comment)} -> 
+        P.string f s;
+        cxt
+      | _ ->  
+        let cxt =
+          (
+            if exp_need_paren  e
+            then P.paren_group f 1
+            else P.group f 0
+          ) (fun _ -> expression ~level:0 cxt f e ) in
+        semi f;
+        cxt)
   | Block b -> (* No braces needed here *)
     ipp_comment f L.start_block;
     let cxt = statement_list top cxt  f b in

jscomp/core/js_dump_program.ml

@@ -48,6 +48,21 @@ let deps_program_is_empty (x : J.deps_program) =
     } -> program_is_empty program
   | _ -> false 
 
+let rec extract_block_comments acc (x : J.block) = 
+  match x with 
+  | {statement_desc = Exp {expression_desc = Raw_js_code {code ; code_info = Stmt (Js_stmt_comment)}} } :: rest
+      -> extract_block_comments (code :: acc) rest 
+  | _ -> (acc ,x)
+
+
+let extract_file_comments  (x : J.deps_program) = 
+  let comments, new_block = extract_block_comments [] x.program.block in 
+  comments , {x with program = {x.program with block = new_block}}
+    
+
+
+
+
 let program f cxt   ( x : J.program ) = 
   P.force_newline f;
   let cxt =  Js_dump.statement_list true cxt f x.block  in
@@ -107,7 +122,7 @@ let es6_program  ~output_dir fmt f (  x : J.deps_program) =
 *)
 
 let pp_deps_program
-    ~output_prefix
+    ~(output_prefix : string)
     (kind : Js_packages_info.module_system )
     (program  : J.deps_program) (f : Ext_pp.t) = 
   if not !Js_config.no_version_header then 
@@ -119,6 +134,8 @@ let pp_deps_program
     P.string f empty_explanation 
     (* This is empty module, it won't be referred anywhere *)
   else 
+    let comments, program = extract_file_comments program  in 
+    Ext_list.rev_iter comments (fun comment -> P.string f comment; P.newline f) ;
     let output_dir = Filename.dirname output_prefix in   
     begin 
       ignore (match kind with 

jscomp/core/js_exp_make.ml

@@ -125,7 +125,7 @@ let unicode ?comment s : t =
   {expression_desc = Unicode (s); comment}
 
 let raw_js_code ?comment info s : t =
-  {expression_desc = Raw_js_code (s,info) ; comment }
+  {expression_desc = Raw_js_code {code = String.trim s; code_info = info} ; comment }
 
 let raw_js_function ?comment arg block : t = 
   {expression_desc = Raw_js_function(arg,block); comment}

jscomp/core/js_exp_make.mli

@@ -339,7 +339,7 @@ val dummy_obj :
 (** convert a block to expresion by using IIFE *)    
 val of_block : ?comment:string -> ?e:J.expression -> J.statement list -> t
 
-val raw_js_code : ?comment:string -> J.code_info ->  string -> t
+val raw_js_code : ?comment:string -> Js_raw_info.code_info ->  string -> t
 val raw_js_function : ?comment:string -> string -> string list -> t
 val nil : t 
 val is_null : ?comment:string -> t -> t 

jscomp/core/js_fold.ml

@@ -356,8 +356,7 @@ class virtual fold =
           let o = o#block _x_i2 in let o = o#unknown _x_i3 in o
       | Str (_x, _x_i1) -> let o = o#bool _x in let o = o#string _x_i1 in o
       | Unicode _x -> let o = o#string _x in o
-      | Raw_js_code (_x, _x_i1) ->
-          let o = o#string _x in let o = o#code_info _x_i1 in o
+      | Raw_js_code _x -> let o = o#unknown _x in o
       | Raw_js_function (_x, _x_i1) ->
           let o = o#string _x in
           let o = o#list (fun o -> o#string) _x_i1 in o
@@ -386,7 +385,6 @@ class virtual fold =
         let o = o#program _x in
         let o = o#required_modules _x_i1 in
         let o = o#option (fun o -> o#string) _x_i2 in o
-    method code_info : code_info -> 'self_type = o#unknown
     method case_clause :
       (* since in ocaml, it's expression oriented langauge, [return] in
     general has no jumps, it only happens when we do 

jscomp/core/js_map.ml

@@ -392,9 +392,7 @@ class virtual map =
       | Str (_x, _x_i1) ->
           let _x = o#bool _x in let _x_i1 = o#string _x_i1 in Str (_x, _x_i1)
       | Unicode _x -> let _x = o#string _x in Unicode _x
-      | Raw_js_code (_x, _x_i1) ->
-          let _x = o#string _x in
-          let _x_i1 = o#code_info _x_i1 in Raw_js_code (_x, _x_i1)
+      | Raw_js_code _x -> let _x = o#unknown _x in Raw_js_code _x
       | Raw_js_function (_x, _x_i1) ->
           let _x = o#string _x in
           let _x_i1 = o#list (fun o -> o#string) _x_i1
@@ -429,7 +427,6 @@ class virtual map =
         let _x_i1 = o#required_modules _x_i1 in
         let _x_i2 = o#option (fun o -> o#string) _x_i2
         in { program = _x; modules = _x_i1; side_effect = _x_i2; }
-    method code_info : code_info -> code_info = o#unknown
     method case_clause :
       (* since in ocaml, it's expression oriented langauge, [return] in
     general has no jumps, it only happens when we do 

jscomp/core/js_op.ml

@@ -242,9 +242,6 @@ type length_object =
   | Function
   | Caml_block
 
-type code_info = 
-  | Exp of Js_raw_exp_info.t 
-  | Stmt
 (** TODO: define constant - for better constant folding  *)
 (* type constant =  *)
 (*   | Const_int of int *)