Static eval backend type

CHANGES.md

@@ -1,4 +1,6 @@
 # dev (2021-??-??) - ??
+## Features/Changes
+* Compiler: static evaluation of backend_type
 
 ## Bug fixes
 * Compiler: fix sourcemap warning for empty cma

compiler/lib/eval.ml

@@ -197,13 +197,13 @@ let eval_instr info i =
       match the_const_of info y, the_const_of info z with
       | Some e1, Some e2 -> (
           match constant_equal e1 e2 with
-          | None -> i
+          | None -> [ i ]
           | Some c ->
               let c = if c then 1l else 0l in
               let c = Constant (Int c) in
               Flow.update_def info x c;
-              Let (x, c))
-      | _ -> i)
+              [ Let (x, c) ])
+      | _ -> [ i ])
   | Let (x, Prim (Extern "caml_ml_string_length", [ s ])) -> (
       let c =
         match s with
@@ -212,24 +212,29 @@ let eval_instr info i =
         | _ -> None
       in
       match c with
-      | None -> i
+      | None -> [ i ]
       | Some c ->
           let c = Constant (Int c) in
           Flow.update_def info x c;
-          Let (x, c))
+          [ Let (x, c) ])
   | Let (_, Prim (Extern ("caml_array_unsafe_get" | "caml_array_unsafe_set"), _)) ->
       (* Fresh parameters can be introduced for these primitives
            in Specialize_js, which would make the call to [the_const_of]
            below fail. *)
-      i
+      [ i ]
   | Let (x, Prim (IsInt, [ y ])) -> (
       match is_int info y with
-      | Unknown -> i
+      | Unknown -> [ i ]
       | (Y | N) as b ->
           let b = if Poly.(b = N) then 0l else 1l in
           let c = Constant (Int b) in
           Flow.update_def info x c;
-          Let (x, c))
+          [ Let (x, c) ])
+  | Let (x, Prim (Extern "caml_sys_const_backend_type", [ _ ])) ->
+      let jsoo = Code.Var.fresh () in
+      [ Let (jsoo, Constant (String "js_of_ocaml"))
+      ; Let (x, Block (0, [| jsoo |], NotArray))
+      ]
   | Let (x, Prim (prim, prim_args)) -> (
       let prim_args' = List.map prim_args ~f:(fun x -> the_const_of info x) in
       let res =
@@ -248,22 +253,23 @@ let eval_instr info i =
       | Some c ->
           let c = Constant c in
           Flow.update_def info x c;
-          Let (x, c)
+          [ Let (x, c) ]
       | _ ->
-          Let
-            ( x
-            , Prim
-                ( prim
-                , List.map2 prim_args prim_args' ~f:(fun arg c ->
-                      match c with
-                      | Some ((Int _ | Float _ | IString _) as c) -> Pc c
-                      | Some (String _ as c) when Config.Flag.use_js_string () -> Pc c
-                      | Some _
-                      (* do not be duplicated other constant as
-                          they're not represented with constant in javascript. *)
-                      | None ->
-                          arg) ) ))
-  | _ -> i
+          [ Let
+              ( x
+              , Prim
+                  ( prim
+                  , List.map2 prim_args prim_args' ~f:(fun arg c ->
+                        match c with
+                        | Some ((Int _ | Float _ | IString _) as c) -> Pc c
+                        | Some (String _ as c) when Config.Flag.use_js_string () -> Pc c
+                        | Some _
+                        (* do not be duplicated other constant as
+                            they're not represented with constant in javascript. *)
+                        | None ->
+                            arg) ) )
+          ])
+  | _ -> [ i ]
 
 type case_of =
   | CConst of int
@@ -385,7 +391,7 @@ let drop_exception_handler blocks =
 let eval info blocks =
   Addr.Map.map
     (fun block ->
-      let body = List.map block.body ~f:(eval_instr info) in
+      let body = List.concat_map block.body ~f:(eval_instr info) in
       let branch = eval_branch info block.branch in
       { block with Code.body; Code.branch })
     blocks

compiler/tests-compiler/static_eval.ml

@@ -76,3 +76,23 @@ let%expect_test "static eval of string get" =
     var ex = call_with_char(caml_string_get(constant,- 10));
     var ax = call_with_char(103);
     var bx = call_with_char(caml_string_get(constant,30)); |}]
+
+let%expect_test "static eval of Sys.backend_type" =
+  let program =
+    compile_and_parse_whole_program
+      {|
+    exception Myfun of (unit -> int)
+    let myfun () = 
+      let constant = match Sys.backend_type with
+      | Other "js_of_ocaml" -> 42
+      | Native -> 1
+      | Bytecode -> 2
+      | Other _ -> 3
+      in
+      constant
+    let () = raise (Myfun myfun)
+  |}
+  in
+  print_fun_decl program (Some "myfun");
+  [%expect {|
+    function myfun(param){return 42} |}]

compiler/tests-compiler/util/util.ml

@@ -311,12 +311,18 @@ let compile_ocaml_to_cmo ?(debug = true) file =
   print_string stdout;
   Filetype.cmo_file_of_path out_file
 
-let compile_ocaml_to_bc file =
+let compile_ocaml_to_bc ?(debug = true) file =
   let file = Filetype.path_of_ocaml_file file in
   let out_file = swap_extention file ~ext:"bc" in
   let (stdout : string) =
     exec_to_string_exn
-      ~cmd:(Format.sprintf "%s -g unix.cma %s -o %s" ocamlc file out_file)
+      ~cmd:
+        (Format.sprintf
+           "%s %s unix.cma %s -o %s"
+           ocamlc
+           (if debug then "-g" else "")
+           file
+           out_file)
   in
   print_string stdout;
   Filetype.bc_file_of_path out_file
@@ -385,6 +391,8 @@ class find_function_declaration r n =
       super#source s
   end
 
+let print_program p = print_string (program_to_string p)
+
 let print_fun_decl program n =
   let r = ref [] in
   let o = new find_function_declaration r n in
@@ -414,6 +422,15 @@ let compile_and_run ?flags s =
       |> run_javascript
       |> print_endline)
 
+let compile_and_parse_whole_program ?(debug = true) ?flags s =
+  with_temp_dir ~f:(fun () ->
+      s
+      |> Filetype.ocaml_text_of_string
+      |> Filetype.write_ocaml ~name:"test.ml"
+      |> compile_ocaml_to_bc ~debug
+      |> compile_bc_to_javascript ?flags ~pretty:true ~sourcemap:debug
+      |> parse_js)
+
 let compile_and_parse ?(debug = true) ?flags s =
   with_temp_dir ~f:(fun () ->
       s

compiler/tests-compiler/util/util.mli

@@ -27,7 +27,7 @@ val parse_js : Filetype.js_file -> Javascript.program
 
 val compile_ocaml_to_cmo : ?debug:bool -> Filetype.ocaml_file -> Filetype.cmo_file
 
-val compile_ocaml_to_bc : Filetype.ocaml_file -> Filetype.bc_file
+val compile_ocaml_to_bc : ?debug:bool -> Filetype.ocaml_file -> Filetype.bc_file
 
 val compile_lib : Filetype.cmo_file list -> string -> Filetype.cmo_file
 
@@ -56,6 +56,8 @@ val expression_to_string : ?compact:bool -> Javascript.expression -> string
 
 val print_file : string -> unit
 
+val print_program : Javascript.program -> unit
+
 val print_var_decl : Javascript.program -> string -> unit
 
 val print_fun_decl : Javascript.program -> string option -> unit
@@ -66,4 +68,7 @@ val compile_and_run_bytecode : string -> unit
 
 val compile_and_parse : ?debug:bool -> ?flags:string list -> string -> Javascript.program
 
+val compile_and_parse_whole_program :
+  ?debug:bool -> ?flags:string list -> string -> Javascript.program
+
 val normalize_path : string -> string