Merge pull request #3747 from BuckleScript/clean

add bsc -e "let a = 3"

Author: bobzhang

jscomp/core/js_implementation.ml

@@ -92,6 +92,14 @@ let interface_mliast ppf fname outputprefix  =
   |> print_if ppf Clflags.dump_source Pprintast.signature 
   |> after_parsing_sig ppf  outputprefix 
 
+
+let get_lambda = fun   
+#if OCAML_VERSION =~ ">4.03.0" then
+              {code = lambda}
+#else
+              lambda
+#end              -> lambda 
+
 let after_parsing_impl ppf  outputprefix ast =
 
   if !Js_config.binary_ast then
@@ -104,45 +112,37 @@ let after_parsing_impl ppf  outputprefix ast =
     Warnings.check_fatal ()
   else 
     begin
-
       if Js_config.get_diagnose () then
         Format.fprintf Format.err_formatter "Building %s@." !Location.input_name;      
-      let modulename = Compenv.module_of_filename ppf !Location.input_name outputprefix in
+      let modulename = Ext_filename.module_name outputprefix in
       Lam_compile_env.reset () ;
       let env = Compmisc.initial_env() in
       Env.set_unit_name modulename;
-      
-        let (typedtree, coercion, finalenv, current_signature) =
-          ast 
-          |> Typemod.type_implementation_more ?check_exists:(if !Js_config.force_cmi then None else Some ()) !Location.input_name outputprefix modulename env 
-          |> print_if ppf Clflags.dump_typedtree
-            (fun fmt (ty,co,_,_) -> Printtyped.implementation_with_coercion fmt  (ty,co))
-        in
-        if !Clflags.print_types || !Js_config.cmi_only then begin
-          Warnings.check_fatal ();
-        end else begin
-          (typedtree, coercion)
-          |> Translmod.transl_implementation modulename
 
-          |> (fun 
-#if OCAML_VERSION =~ ">4.03.0" then
-              {code = lambda}
-#else
-              lambda
-#end              
-               -> 
-              ignore (print_if ppf Clflags.dump_rawlambda Printlambda.lambda lambda);
-                Lam_compile_main.lambda_as_module
-                  finalenv  
-                  outputprefix lambda
-            );
-
-        end;
+      let (typedtree, coercion, finalenv, current_signature) =
+        ast 
+        |> Typemod.type_implementation_more ?check_exists:(if !Js_config.force_cmi then None else Some ()) !Location.input_name outputprefix modulename env 
+        |> print_if ppf Clflags.dump_typedtree
+          (fun fmt (ty,co,_,_) -> Printtyped.implementation_with_coercion fmt  (ty,co))
+      in
+      if !Clflags.print_types || !Js_config.cmi_only then begin
+        Warnings.check_fatal ();
+      end else begin
+        (typedtree, coercion)
+        |> Translmod.transl_implementation modulename
+        |> (fun lambda -> 
+            print_if ppf Clflags.dump_rawlambda Printlambda.lambda (get_lambda lambda)
+            |>
+            Lam_compile_main.lambda_as_module
+              finalenv  
+              outputprefix 
+          );
+      end;
         Stypes.dump (Some (outputprefix ^ ".annot"));
     end
-let implementation ppf sourcefile outputprefix =
+let implementation ppf fname outputprefix =
   Compmisc.init_path false;
-  Ocaml_parse.parse_implementation ppf sourcefile
+  Ocaml_parse.parse_implementation ppf fname
   |> print_if ppf Clflags.dump_parsetree Printast.implementation
   |> print_if ppf Clflags.dump_source Pprintast.structure
   |> after_parsing_impl ppf outputprefix 

jscomp/core/ocaml_parse.ml

@@ -30,8 +30,6 @@ let parse_interface ppf sourcefile =
   Ppx_entry.rewrite_signature (Pparse.parse_interface ~tool_name:Js_config.tool_name ppf sourcefile)
 
 
-let lazy_parse_interface ppf sourcefile =
-  lazy (parse_interface ppf sourcefile)
 
 let parse_implementation ppf sourcefile = 
   Ppx_entry.rewrite_implementation
@@ -44,17 +42,6 @@ let parse_implementation ppf sourcefile =
 #end
       )
 
-let parse_implementation_from_string  str = 
-  let lb = Lexing.from_string str in
-  let fname =  "//toplevel//" in 
-  Location.input_name := fname;
-  Location.init lb fname;
-  Ppx_entry.rewrite_implementation (Parse.implementation lb)
-
-
-let lazy_parse_implementation ppf sourcefile =
-  lazy (parse_implementation ppf sourcefile)
-
 type valid_input = 
   | Ml 
   | Mli

jscomp/core/ocaml_parse.mli

@@ -22,14 +22,16 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
-val parse_interface : Format.formatter -> string -> Parsetree.signature
+val parse_interface : 
+  Format.formatter -> 
+  string -> 
+  Parsetree.signature
 
-val parse_implementation : Format.formatter -> string -> Parsetree.structure
+val parse_implementation : 
+  Format.formatter -> 
+  string -> 
+  Parsetree.structure
 
-val parse_implementation_from_string : string -> Parsetree.structure
-val lazy_parse_interface : Format.formatter -> string -> Parsetree.signature lazy_t
-
-val lazy_parse_implementation : Format.formatter -> string -> Parsetree.structure lazy_t
 
 type valid_input = 
   | Ml

jscomp/ext/ext_io.ml

@@ -25,7 +25,7 @@
 
 (** on 32 bit , there are 16M limitation *)
 let load_file f =
-  Ext_pervasives.finally (open_in_bin f) close_in begin fun ic ->   
+  Ext_pervasives.finally (open_in_bin f) ~clean:close_in begin fun ic ->   
     let n = in_channel_length ic in
     let s = Bytes.create n in
     really_input ic s 0 n;
@@ -42,10 +42,13 @@ let  rev_lines_of_chann chan =
 
 
 let rev_lines_of_file file = 
-  Ext_pervasives.finally (open_in_bin file) close_in rev_lines_of_chann
-  
+  Ext_pervasives.finally 
+    ~clean:close_in 
+    (open_in_bin file) rev_lines_of_chann
+
 
 let write_file f content = 
-  Ext_pervasives.finally (open_out_bin f) close_out begin fun oc ->   
+  Ext_pervasives.finally ~clean:close_out 
+    (open_out_bin f)  begin fun oc ->   
     output_string oc content
   end

jscomp/ext/ext_pervasives.ml

@@ -29,7 +29,7 @@
 
 external reraise: exn -> 'a = "%reraise"
 
-let finally v action f   = 
+let finally v ~clean:action f   = 
   match f v with
   | exception e -> 
       action v ;
@@ -40,10 +40,10 @@ let try_it f  =
   try ignore (f ()) with _ -> ()
 
 let with_file_as_chan filename f = 
-  finally (open_out_bin filename) close_out f 
+  finally (open_out_bin filename) ~clean:close_out f 
 
 let with_file_as_pp filename f = 
-  finally (open_out_bin filename) close_out
+  finally (open_out_bin filename) ~clean:close_out
     (fun chan -> 
       let fmt = Format.formatter_of_out_channel chan in
       let v = f  fmt in

jscomp/ext/ext_pervasives.mli

@@ -34,7 +34,10 @@
 
 external reraise: exn -> 'a = "%reraise"
 
-val finally : 'a -> ('a -> 'c) -> ('a -> 'b) -> 'b
+val finally : 
+  'a ->
+  clean:('a -> 'c) -> 
+  ('a -> 'b) -> 'b
 
 val try_it : (unit -> 'a) ->  unit 
 

jscomp/ext/ext_pp.ml

@@ -97,7 +97,8 @@ let group t i action =
   else
     let old = t.indent_level in
     t.indent_level <- t.indent_level + i;
-    Ext_pervasives.finally () (fun _ -> t.indent_level <- old) action
+    Ext_pervasives.finally ~clean:(fun _ -> t.indent_level <- old)
+    ()  action
 
 let vgroup = group
 

jscomp/main/js_main.ml

@@ -93,13 +93,14 @@ let intf filename =
 #end      
   ; process_interface_file ppf filename;;
 
-let eval_string = ref ""        
-
-let set_eval_string s = 
-  eval_string :=  s 
-
 
 
+let eval (s : string) ~suffix =
+  let tmpfile = Filename.temp_file "eval" suffix in 
+  Ext_io.write_file tmpfile s;   
+  Ext_pervasives.finally  tmpfile anonymous ~clean:(fun _ ->
+      try Sys.remove tmpfile with _ -> () 
+    )
 
 let (//) = Filename.concat
 
@@ -186,8 +187,13 @@ let buckle_script_flags : (string * Arg.spec * string) list =
    " disable binary annotations (by default on)")
   ::
   ("-bs-eval", 
-   Arg.String set_eval_string, 
-   " (experimental) Set the string to be evaluated, note this flag will be conflicted with -bs-main"
+   Arg.String (fun  s -> eval s ~suffix:Literals.suffix_ml), 
+   " (experimental) Set the string to be evaluated in OCaml syntax"
+  )
+  ::
+  ("-e", 
+   Arg.String (fun  s -> eval s ~suffix:Literals.suffix_re), 
+   " (experimental) Set the string to be evaluated in ReasonML syntax"
   )
   ::
   (
@@ -281,37 +287,6 @@ let buckle_script_flags : (string * Arg.spec * string) list =
   :: Ocaml_options.ocaml_options
 
 
-let print_if ppf flag printer arg =
-  if !flag then Format.fprintf ppf "%a@." printer arg;
-  arg
-
-let eval ppf s =
-#if OCAML_VERSION =~ ">4.03.0" then
-  Compenv.readenv ppf (Before_compile "//<toplevel>//"); (*FIXME*)
-#else
-  Compenv.readenv ppf Before_compile; 
-#end  
-  Compmisc.init_path  false;
-      Ext_ref.protect_list 
-        [Clflags.dont_write_files , true ; 
-         Clflags.annotations, false;
-         Clflags.binary_annotations, false;
-        ]  (fun _ -> 
-            Ocaml_parse.parse_implementation_from_string s 
-            (* FIXME: Note in theory, the order of applying our built in ppx 
-               and apply third party ppx should not matter, but in practice  
-               it may.
-               We should make it more consistent. 
-               Thirdy party ppx may be buggy to drop annotations.
-               If we always put our ppx in the beginning, it will be more robust, 
-               however, the current implementation (in the batch compilation mode) 
-               seems to apply our ppx after all ppx transformations
-            *)
-            |> Pparse.apply_rewriters_str ~tool_name:Js_config.tool_name
-            |> print_if ppf Clflags.dump_parsetree Printast.implementation
-            |> print_if ppf Clflags.dump_source Pprintast.structure
-            |> Js_implementation.after_parsing_impl ppf  "Bs_internal_eval" 
-          )
 
 
 
@@ -335,11 +310,7 @@ let _ =
   Bs_conditional_initial.setup_env ();
   try
     Compenv.readenv ppf Before_args;
-    Arg.parse buckle_script_flags anonymous usage;
-    let eval_string = !eval_string in
-    if eval_string <> "" then 
-      eval ppf eval_string
-    
+    Arg.parse buckle_script_flags anonymous usage    
   with x -> 
     begin
 #if undefined BS_RELEASE_BUILD then      

jscomp/main/jscmj_main.ml

@@ -46,7 +46,7 @@ let from_cmj (files : string list) (output_file : string) =
     Ext_pp.string f "\""
   in  
   let v = open_out_bin output_file in
-  Ext_pervasives.finally v close_out (fun v ->   
+  Ext_pervasives.finally v ~clean:close_out (fun v ->   
       let f = Ext_pp.from_channel v in  
       let aux file =                 
         let str = Ext_io.load_file file in
@@ -83,7 +83,7 @@ let from_cmi (files : string list) (output_file : string) =
     Ext_pp.string f "\""
   in  
   let v = open_out_bin output_file in
-  Ext_pervasives.finally v close_out (fun v ->   
+  Ext_pervasives.finally v ~clean:close_out (fun v ->   
       let f = Ext_pp.from_channel v in  
       let aux file = 
         let cmi = Cmi_format.read_cmi file in 

jscomp/syntax/ast_reason_pp.ml

@@ -32,7 +32,7 @@ exception Pp_error
 let pp (sourcefile : string) =
 
 
-  let tmpfile = Filename.temp_file "ocamlpp" "" in
+  let tmpfile = Filename.temp_file "bspp" "" in
   let pp = (*TODO: check to avoid double quoting *)
     Ext_filename.maybe_quote 
       (match !Js_config.refmt with