Skip to content

Commit

Permalink
Target-specific code
Browse files Browse the repository at this point in the history
  • Loading branch information
vouillon authored and OlivierNicole committed Sep 3, 2024
1 parent 613cbcc commit 4a28c27
Show file tree
Hide file tree
Showing 17 changed files with 424 additions and 214 deletions.
2 changes: 1 addition & 1 deletion compiler/bin-js_of_ocaml/build_fs.ml
Original file line number Diff line number Diff line change
Expand Up @@ -75,10 +75,10 @@ function jsoo_create_file_extern(name,content){
let pfs_fmt = Pretty_print.to_out_channel chan in
let (_ : Source_map.t option) =
Driver.f
~target:(JavaScript pfs_fmt)
~standalone:true
~wrap_with_fun:`Iife
~link:`Needed
pfs_fmt
(Parse_bytecode.Debug.create ~include_cmis:false false)
code
in
Expand Down
10 changes: 7 additions & 3 deletions compiler/bin-js_of_ocaml/compile.ml
Original file line number Diff line number Diff line change
Expand Up @@ -196,12 +196,12 @@ let run
in
let code = Code.prepend one.code instr in
Driver.f
~target:(JavaScript fmt)
~standalone
?profile
~link
~wrap_with_fun
?source_map
fmt
one.debug
code
| `File, fmt ->
Expand All @@ -220,12 +220,12 @@ let run
let code = Code.prepend one.code instr in
let res =
Driver.f
~target:(JavaScript fmt)
~standalone
?profile
~link
~wrap_with_fun
?source_map
fmt
one.debug
code
in
Expand Down Expand Up @@ -285,7 +285,7 @@ let run
| `None ->
let prims = Linker.list_all () |> StringSet.elements in
assert (List.length prims > 0);
let code, uinfo = Parse_bytecode.predefined_exceptions () in
let code, uinfo = Parse_bytecode.predefined_exceptions ~target:`JavaScript in
let uinfo = { uinfo with primitives = uinfo.primitives @ prims } in
let code : Parse_bytecode.one =
{ code
Expand Down Expand Up @@ -331,6 +331,7 @@ let run
let linkall = linkall || toplevel || dynlink in
let code =
Parse_bytecode.from_exe
~target:`JavaScript
~includes:include_dirs
~include_cmis
~link_info:(toplevel || dynlink)
Expand Down Expand Up @@ -363,6 +364,7 @@ let run
let t1 = Timer.make () in
let code =
Parse_bytecode.from_cmo
~target:`JavaScript
~includes:include_dirs
~include_cmis
~debug:need_debug
Expand Down Expand Up @@ -419,6 +421,7 @@ let run
let t1 = Timer.make () in
let code =
Parse_bytecode.from_cmo
~target:`JavaScript
~includes:include_dirs
~include_cmis
~debug:need_debug
Expand Down Expand Up @@ -450,6 +453,7 @@ let run
let t1 = Timer.make () in
let code =
Parse_bytecode.from_cmo
~target:`JavaScript
~includes:include_dirs
~include_cmis
~debug:need_debug
Expand Down
144 changes: 95 additions & 49 deletions compiler/lib/driver.ml
Original file line number Diff line number Diff line change
Expand Up @@ -44,34 +44,35 @@ let deadcode p =
let r, _ = deadcode' p in
r

let inline p =
let inline ~target p =
if Config.Flag.inline () && Config.Flag.deadcode ()
then (
let p, live_vars = deadcode' p in
if debug () then Format.eprintf "Inlining...@.";
Inline.f p live_vars)
Inline.f ~target p live_vars)
else p

let specialize_1 (p, info) =
if debug () then Format.eprintf "Specialize...@.";
Specialize.f ~function_arity:(fun f -> Specialize.function_arity info f) p

let specialize_js (p, info) =
let specialize_js ~target (p, info) =
if debug () then Format.eprintf "Specialize js...@.";
Specialize_js.f info p
Specialize_js.f ~target info p

let specialize_js_once p =
if debug () then Format.eprintf "Specialize js once...@.";
Specialize_js.f_once p

let specialize' (p, info) =
let specialize' ~target (p, info) =
let p = specialize_1 (p, info) in
let p = specialize_js (p, info) in
let p = specialize_js ~target (p, info) in
p, info

let specialize p = fst (specialize' p)
let specialize ~target p = fst (specialize' ~target p)

let eval (p, info) = if Config.Flag.staticeval () then Eval.f info p else p
let eval ~target (p, info) =
if Config.Flag.staticeval () then Eval.f ~target info p else p

let flow p =
if debug () then Format.eprintf "Data flow...@.";
Expand Down Expand Up @@ -143,51 +144,54 @@ let identity x = x

(* o1 *)

let o1 : 'a -> 'a =
let o1 ~target : 'a -> 'a =
print
+> tailcall
+> flow_simple (* flow simple to keep information for future tailcall opt *)
+> specialize'
+> eval
+> inline (* inlining may reveal new tailcall opt *)
+> specialize' ~target
+> eval ~target
+> inline ~target (* inlining may reveal new tailcall opt *)
+> deadcode
+> tailcall
+> phi
+> flow
+> specialize'
+> eval
+> inline
+> specialize' ~target
+> eval ~target
+> inline ~target
+> deadcode
+> print
+> flow
+> specialize'
+> eval
+> inline
+> specialize' ~target
+> eval ~target
+> inline ~target
+> deadcode
+> phi
+> flow
+> specialize
+> specialize ~target
+> identity

(* o2 *)

let o2 : 'a -> 'a = loop 10 "o1" o1 1 +> print
let o2 ~target : 'a -> 'a = loop 10 "o1" (o1 ~target) 1 +> print

(* o3 *)

let round1 : 'a -> 'a =
let round1 ~target : 'a -> 'a =
print
+> tailcall
+> inline (* inlining may reveal new tailcall opt *)
+> inline ~target (* inlining may reveal new tailcall opt *)
+> deadcode (* deadcode required before flow simple -> provided by constant *)
+> flow_simple (* flow simple to keep information for future tailcall opt *)
+> specialize'
+> eval
+> specialize' ~target
+> eval ~target
+> identity

let round2 = flow +> specialize' +> eval +> deadcode +> o1
let round2 ~target = flow +> specialize' ~target +> eval ~target +> deadcode +> o1 ~target

let o3 = loop 10 "tailcall+inline" round1 1 +> loop 10 "flow" round2 1 +> print
let o3 ~target =
loop 10 "tailcall+inline" (round1 ~target) 1
+> loop 10 "flow" (round2 ~target) 1
+> print

let generate
d
Expand Down Expand Up @@ -658,13 +662,39 @@ let configure formatter =
Code.Var.set_pretty (pretty && not (Config.Flag.shortvar ()));
Code.Var.set_stable (Config.Flag.stable_var ())

let full ~standalone ~wrap_with_fun ~profile ~link ~source_map formatter d p =
let exported_runtime = not standalone in
type 'a target =
| JavaScript : Pretty_print.t -> Source_map.t option target
| Wasm
: (Deadcode.variable_uses * Effects.in_cps * Code.program * Parse_bytecode.Debug.t)
target

let target_flag (type a) (t : a target) =
match t with
| JavaScript _ -> `JavaScript
| Wasm -> `Wasm

let link_and_pack ?(standalone = true) ?(wrap_with_fun = `Iife) ?(link = `No) p =
let export_runtime =
match link with
| `All | `All_from _ -> true
| `Needed | `No -> false
in
p
|> link' ~export_runtime ~standalone ~link
|> pack ~wrap_with_fun ~standalone
|> coloring
|> check_js

let full
(type result)
~(target : result target)
~standalone
~wrap_with_fun
~profile
~link
~source_map
d
p : result =
let deadcode_sentinal =
(* If deadcode is disabled, this field is just fresh variable *)
Code.Var.fresh_n "undef"
Expand All @@ -675,58 +705,74 @@ let full ~standalone ~wrap_with_fun ~profile ~link ~source_map formatter d p =
| O1 -> o1
| O2 -> o2
| O3 -> o3)
~target:(target_flag target)
+> exact_calls ~deadcode_sentinal profile
+> effects ~deadcode_sentinal
+> map_fst (if Config.Flag.effects () then fun x -> x else Generate_closure.f)
+> map_fst
(match target with
| JavaScript _ -> if Config.Flag.effects () then Fun.id else Generate_closure.f
| Wasm -> Fun.id)
+> map_fst deadcode'
in
let emit =
generate
d
~exported_runtime
~wrap_with_fun
~warn_on_unhandled_effect:standalone
~deadcode_sentinal
+> link' ~export_runtime ~standalone ~link
+> pack ~wrap_with_fun ~standalone
+> coloring
+> check_js
+> output formatter ~source_map ()
in
if times () then Format.eprintf "Start Optimizing...@.";
let t = Timer.make () in
let r = opt p in
let () = if times () then Format.eprintf " optimizations : %a@." Timer.print t in
emit r
match target with
| JavaScript formatter ->
let exported_runtime = not standalone in
let emit formatter =
generate
d
~exported_runtime
~wrap_with_fun
~warn_on_unhandled_effect:standalone
~deadcode_sentinal
+> link_and_pack ~standalone ~wrap_with_fun ~link
+> output formatter ~source_map ()
in
let source_map = emit formatter r in
source_map
| Wasm ->
let (p, live_vars), _, in_cps = r in
live_vars, in_cps, p, d

let full_no_source_map ~standalone ~wrap_with_fun ~profile ~link formatter d p =
let full_no_source_map ~formatter ~standalone ~wrap_with_fun ~profile ~link d p =
let (_ : Source_map.t option) =
full ~standalone ~wrap_with_fun ~profile ~link ~source_map:None formatter d p
full
~target:(JavaScript formatter)
~standalone
~wrap_with_fun
~profile
~link
~source_map:None
d
p
in
()

let f
~target
?(standalone = true)
?(wrap_with_fun = `Iife)
?(profile = O1)
~link
?source_map
formatter
d
p =
full ~standalone ~wrap_with_fun ~profile ~link ~source_map formatter d p
full ~target ~standalone ~wrap_with_fun ~profile ~link ~source_map d p

let f' ?(standalone = true) ?(wrap_with_fun = `Iife) ?(profile = O1) ~link formatter d p =
full_no_source_map ~standalone ~wrap_with_fun ~profile ~link formatter d p
full_no_source_map ~formatter ~standalone ~wrap_with_fun ~profile ~link d p

let from_string ~prims ~debug s formatter =
let p, d = Parse_bytecode.from_string ~prims ~debug s in
full_no_source_map
~formatter
~standalone:false
~wrap_with_fun:`Anonymous
~profile:O1
~link:`No
formatter
d
p

Expand Down
19 changes: 16 additions & 3 deletions compiler/lib/driver.mli
Original file line number Diff line number Diff line change
Expand Up @@ -20,16 +20,22 @@

type profile

type 'a target =
| JavaScript : Pretty_print.t -> Source_map.t option target
| Wasm
: (Deadcode.variable_uses * Effects.in_cps * Code.program * Parse_bytecode.Debug.t)
target

val f :
?standalone:bool
target:'result target
-> ?standalone:bool
-> ?wrap_with_fun:[ `Iife | `Anonymous | `Named of string ]
-> ?profile:profile
-> link:[ `All | `All_from of string list | `Needed | `No ]
-> ?source_map:Source_map.t
-> Pretty_print.t
-> Parse_bytecode.Debug.t
-> Code.program
-> Source_map.t option
-> 'result

val f' :
?standalone:bool
Expand All @@ -48,6 +54,13 @@ val from_string :
-> Pretty_print.t
-> unit

val link_and_pack :
?standalone:bool
-> ?wrap_with_fun:[ `Iife | `Anonymous | `Named of string ]
-> ?link:[ `All | `All_from of string list | `Needed | `No ]
-> Javascript.statement_list
-> Javascript.statement_list

val configure : Pretty_print.t -> unit

val profiles : (int * profile) list
Expand Down
Loading

0 comments on commit 4a28c27

Please sign in to comment.