Commit 1c27d9bf authored by Mário Pereira's avatar Mário Pereira
Browse files

Code extraction: optimizing proxy variables

parent 1b15d481
......@@ -779,15 +779,19 @@ module Transform = struct
let mk n = { e with e_node = n } in
let add_subst pv e1 e2 = expr info (Mpv.add pv e1 subst) e2 in
match e.e_node with
| Evar pv ->
(try Mpv.find pv subst with Not_found -> e)
| Elet (Lvar (pv, ({e_node = Econst _ } as e1)), e2)
| Elet (Lvar (pv, ({e_node = Eblock []} as e1)), e2) ->
add_subst pv e1 e2
| Elet (Lvar (pv, ({e_node = Eapp (rs, [])} as e1)), e2)
when Translate.isconstructor info rs ->
(* only optimize constructors with no argument *)
(* because of Lvar we know the constructor is completely applied *)
| Evar pv -> (try Mpv.find pv subst with Not_found -> e)
(* | Elet (Lvar (pv, ({e_node = Econst _ } as e1)), e2) *)
(* | Elet (Lvar (pv, ({e_node = Eblock []} as e1)), e2) *)
(* when Slab.mem Expr.proxy_label pv.pv_vs.vs_name.id_label -> *)
(* add_subst pv e1 e2 *)
(* | Elet (Lvar (pv, ({e_node = Eapp (rs, _)} as e1)), e2) *)
(* when Translate.isconstructor info rs && *)
(* Slab.mem Expr.proxy_label pv.pv_vs.vs_name.id_label -> *)
(* (\* because of Lvar we know the constructor is completely applied *\) *)
(* add_subst pv e1 e2 *)
| Elet (Lvar (pv, e1), e2)
when Slab.mem Expr.proxy_label pv.pv_vs.vs_name.id_label ->
let e1 = expr info subst e1 in
add_subst pv e1 e2
| Elet (ld, e) ->
mk (Elet (let_def info subst ld, expr info subst e))
......@@ -797,8 +801,6 @@ module Transform = struct
mk (Efun (vl, expr info subst e))
| Eif (e1, e2, e3) ->
mk (Eif (expr info subst e1, expr info subst e2, expr info subst e3))
(* | Ecast (e, ty) -> *)
(* mk (Ecast (expr info subst e, ty)) *)
| Ematch (e, bl) ->
mk (Ematch (expr info subst e, List.map (branch info subst) bl))
| Eblock el ->
......
......@@ -327,7 +327,7 @@ module Print = struct
| Eapp (rs, []) when rs_equal rs rs_false ->
fprintf fmt "false"
| Eapp (rs, [e1; e2]) when rs_equal rs rs_func_app ->
fprintf fmt "@[<hov 1>%a %a@]"
fprintf fmt (protect_on paren "@[<hov 1>%a %a@]")
(print_expr info) e1 (print_expr info) e2
| Eapp (rs, []) ->
(* avoids parenthesis around values *)
......@@ -374,7 +374,7 @@ module Print = struct
fprintf fmt (protect_on paren "@[<hov 2>(fun %a ->@ %a)@]")
(print_list space (print_vs_arg info)) varl (print_expr info) e
| Ewhile (e1, e2) ->
fprintf fmt "@[<hov 2>while %a do@ %a@ done@]"
fprintf fmt "@[<hov 2>while %a do@\n%a@ done@]"
(print_expr info) e1 (print_expr info) e2
| Eraise (xs, e_opt) ->
print_raise ~paren info xs fmt e_opt
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment