Skip to content
Fetching contributors…
Cannot retrieve contributors at this time
117 lines (100 sloc) 3.1 KB
Copyright © 2011, 2012 MLstate
This file is part of Opa.
Opa is free software: you can redistribute it and/or modify it under the
terms of the GNU Affero General Public License, version 3, as published by
the Free Software Foundation.
Opa is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
more details.
You should have received a copy of the GNU Affero General Public License
along with Opa. If not, see <>.
@author Quentin Bourgerie
module Map = BaseMap
module List = BaseList
module J = JsAst
module U = JsUtils
module JsMap =
Map.Make (struct
type t = J.statement
let compare = U.compare_statement
let rec collect jsmap code =
(fun jsmap -> function
| J.Js_function (l, i, p, b) ->
let noident = J.Js_function (l, J.Native (`global false, ""), p, b) in
JsMap.replace noident
| None -> [i]
| Some [] -> assert false
| Some (id::ids) -> id::i::ids)
| J.Js_block (_, block) -> collect jsmap block
| _ -> jsmap)
let rewrite_expr jsmap =
| J.Je_ident (l, i) as e ->
begin match JsIdentMap.find_opt i jsmap with
| None -> e
| Some i -> J.Je_ident (l, i)
| e -> e
let rec rewrite jsmap code =
| J.Js_function (l, i, p, e) ->
if JsIdentMap.mem i jsmap then None
else Some (J.Js_function (l, i, p, rewrite jsmap e))
| J.Js_block (l, s) -> Some (J.Js_block (l, rewrite jsmap s))
| s -> Some ( (rewrite_expr jsmap) s))
type env = JsAst.ident JsIdentMap.t
let process_code ~pass code =
let module S =
type t = env
let pass = Printf.sprintf "imp_Sharing_%s" pass
let pp fmt m =
JsIdentMap.pp ",@ "
(fun fmt i0 i1 ->
Format.fprintf fmt "%a => %a"
JsPrint.pp#ident i0
JsPrint.pp#ident i1)
fmt m
let module R = ObjectFiles.Make(S)
let jsmap = collect JsMap.empty code in
let env =
(fun _e ids acc ->
match ids with
| id::((_::_) as tail) ->
(fun acc i ->
JsIdentMap.safe_add i id acc
with _ -> acc
) acc tail
| _ -> acc
) jsmap JsIdentMap.empty
in env;
let env = R.fold ~deep:true (JsIdentMap.merge (fun _ _ -> assert false)) env in
let _outputer oc tosave =
let fmt = Format.formatter_of_out_channel oc in
Format.fprintf fmt "%a%!" S.pp tosave
ignore(PassTracker.file ~filename:"js_imp_sharing" _outputer env);
let code = rewrite env code in
code, env
let get_substitute env i = JsIdentMap.find_opt i env
Something went wrong with that request. Please try again.