Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Distinguished lambda constructors for ref variables #10090

Merged
merged 6 commits into from
Jan 8, 2021
Merged

Distinguished lambda constructors for ref variables #10090

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
c351119
added new lambda construct Lmutvar (#9954)
Keryan-dev Dec 7, 2020
6f0765e
added new construct Lmutlet and removed Variable attribute
Keryan-dev Dec 18, 2020
7038524
refactorized Llet and Lmutlet printing
Keryan-dev Dec 18, 2020
f53c21b
Simplified some computations for mutable variable cases
Keryan-dev Jan 6, 2021
28d3196
Fixed an overlooked transformation to Lmutvar and added cautionnary c…
Keryan-dev Jan 6, 2021
423a96c
Added changes entry
Keryan-dev Jan 7, 2021
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
4 changes: 3 additions & 1 deletion Changes
View file
Open in desktop
Expand Up @@ -96,11 +96,13 @@ Working version
changes in the parser.
(François Pottier, review by Gabriel Scherer and Xavier Leroy.)

- #10090: Distinguished constructors for ref variables at lambda level
(Keryan Didier, review by Gabriel Scherer and Vincent Laviron)

- #10113: add a `-timeout` option to ocamltest and use it in the test suite.
(Xavier Leroy and Gabriel Scherer, review by Sébastien Hinderer
and David Allsopp)


### Build system:

- #9191, #10091: take the LDFLAGS variable into account, except on
Expand Down
5 changes: 3 additions & 2 deletions bytecomp/bytegen.ml
View file
Open in desktop
Expand Up @@ -524,7 +524,7 @@ module Storer =
let rec comp_expr env exp sz cont =
if sz > !max_stack_used then max_stack_used := sz;
match exp with
Lvar id ->
Lvar id | Lmutvar id ->
begin try
let pos = Ident.find_same id env.ce_stack in
Kacc(sz - pos) :: cont
Expand Down Expand Up @@ -591,7 +591,8 @@ let rec comp_expr env exp sz cont =
Stack.push to_compile functions_to_compile;
comp_args env (List.map (fun n -> Lvar n) fv) sz
(Kclosure(lbl, List.length fv) :: cont)
| Llet(_str, _k, id, arg, body) ->
| Llet(_, _k, id, arg, body)
| Lmutlet(_k, id, arg, body) ->
comp_expr env arg sz
(Kpush :: comp_expr (add_var id (sz+1) env) body (sz+1)
(add_pop 1 cont))
Expand Down
35 changes: 30 additions & 5 deletions lambda/lambda.ml
View file
Open in desktop
Expand Up @@ -259,7 +259,7 @@ type local_attribute =

type function_kind = Curried | Tupled

type let_kind = Strict | Alias | StrictOpt | Variable
type let_kind = Strict | Alias | StrictOpt

type meth_kind = Self | Public | Cached

Expand All @@ -284,10 +284,12 @@ type scoped_location = Debuginfo.Scoped_location.t

type lambda =
Lvar of Ident.t
| Lmutvar of Ident.t
| Lconst of structured_constant
| Lapply of lambda_apply
| Lfunction of lfunction
| Llet of let_kind * value_kind * Ident.t * lambda * lambda
| Lmutlet of value_kind * Ident.t * lambda * lambda
| Lletrec of (Ident.t * lambda) list * lambda
| Lprim of primitive * lambda list * scoped_location
| Lswitch of lambda * lambda_switch * scoped_location
Expand Down Expand Up @@ -382,7 +384,8 @@ let make_key e =
incr count ;
if !count > max_raw then raise Not_simple ; (* Too big ! *)
match e with
| Lvar id ->
| Lvar id
| Lmutvar id ->
begin
try Ident.find_same id env
with Not_found -> e
Expand All @@ -405,6 +408,10 @@ let make_key e =
let ex = tr_rec env ex in
let y = make_key x in
Llet (str,k,y,ex,tr_rec (Ident.add x (Lvar y) env) e)
| Lmutlet (k,x,ex,e) ->
let ex = tr_rec env ex in
let y = make_key x in
Lmutlet (k,y,ex,tr_rec (Ident.add x (Lmutvar y) env) e)
| Lprim (p,es,_) ->
Lprim (p,tr_recs env es, Loc_unknown)
| Lswitch (e,sw,loc) ->
Expand Down Expand Up @@ -479,12 +486,14 @@ let iter_opt f = function

let shallow_iter ~tail ~non_tail:f = function
Lvar _
| Lmutvar _
| Lconst _ -> ()
| Lapply{ap_func = fn; ap_args = args} ->
f fn; List.iter f args
| Lfunction{body} ->
f body
| Llet(_str, _k, _id, arg, body) ->
| Llet(_, _k, _id, arg, body)
| Lmutlet(_k, _id, arg, body) ->
f arg; tail body
| Lletrec(decl, body) ->
tail body;
Expand Down Expand Up @@ -533,14 +542,16 @@ let iter_head_constructor f l =
shallow_iter ~tail:f ~non_tail:f l

let rec free_variables = function
| Lvar id -> Ident.Set.singleton id
| Lvar id
| Lmutvar id -> Ident.Set.singleton id
| Lconst _ -> Ident.Set.empty
| Lapply{ap_func = fn; ap_args = args} ->
free_variables_list (free_variables fn) args
| Lfunction{body; params} ->
Ident.Set.diff (free_variables body)
(Ident.Set.of_list (List.map fst params))
| Llet(_str, _k, id, arg, body) ->
| Llet(_, _k, id, arg, body)
| Lmutlet(_k, id, arg, body) ->
Ident.Set.union
(free_variables arg)
(Ident.Set.remove id (free_variables body))
Expand Down Expand Up @@ -715,6 +726,14 @@ let subst update_env ?(freshen_bound_variables = false) s input_lam =
to [l]; it is a free variable of the input term. *)
begin try Ident.Map.find id s with Not_found -> lam end
end
| Lmutvar id as lam ->
begin match Ident.Map.find id l with
| id' -> Lmutvar id'
| exception Not_found ->
(* Note: a mutable [id] should not appear in [s].
Keeping the behavior of Lvar case for now. *)
begin try Ident.Map.find id s with Not_found -> lam end
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think it should be an error for a mutable variable to appear in s. Could you leave a comment here so that we remember about it ? For this PR keeping the old behaviour is probably best.

end
| Lconst _ as l -> l
| Lapply ap ->
Lapply{ap with ap_func = subst s l ap.ap_func;
Expand All @@ -725,6 +744,9 @@ let subst update_env ?(freshen_bound_variables = false) s input_lam =
| Llet(str, k, id, arg, body) ->
let id, l' = bind id l in
Llet(str, k, id, subst s l arg, subst s l' body)
| Lmutlet(k, id, arg, body) ->
let id, l' = bind id l in
Lmutlet(k, id, subst s l arg, subst s l' body)
| Lletrec(decl, body) ->
let decl, l' = bind_many decl l in
Lletrec(List.map (subst_decl s l') decl, subst s l' body)
Expand Down Expand Up @@ -818,6 +840,7 @@ let duplicate lam =

let shallow_map f = function
| Lvar _
| Lmutvar _
| Lconst _ as lam -> lam
| Lapply { ap_func; ap_args; ap_loc; ap_tailcall;
ap_inlined; ap_specialised } ->
Expand All @@ -833,6 +856,8 @@ let shallow_map f = function
Lfunction { kind; params; return; body = f body; attr; loc; }
| Llet (str, k, v, e1, e2) ->
Llet (str, k, v, f e1, f e2)
| Lmutlet (k, v, e1, e2) ->
Lmutlet (k, v, f e1, f e2)
| Lletrec (idel, e2) ->
Lletrec (List.map (fun (v, e) -> (v, f e)) idel, f e2)
| Lprim (p, el, loc) ->
Expand Down
5 changes: 3 additions & 2 deletions lambda/lambda.mli
View file
Open in desktop
Expand Up @@ -234,7 +234,7 @@ type local_attribute =

type function_kind = Curried | Tupled

type let_kind = Strict | Alias | StrictOpt | Variable
type let_kind = Strict | Alias | StrictOpt
(* Meaning of kinds for let x = e in e':
Strict: e may have side-effects; always evaluate e first
(If e is a simple expression, e.g. a variable or constant,
Expand All @@ -243,7 +243,6 @@ type let_kind = Strict | Alias | StrictOpt | Variable
in e'
StrictOpt: e does not have side-effects, but depend on the store;
we can discard e if x does not appear in e'
Variable: the variable x is assigned later in e'
*)

type meth_kind = Self | Public | Cached
Expand All @@ -264,10 +263,12 @@ type scoped_location = Debuginfo.Scoped_location.t

type lambda =
Lvar of Ident.t
| Lmutvar of Ident.t
| Lconst of structured_constant
| Lapply of lambda_apply
| Lfunction of lfunction
| Llet of let_kind * value_kind * Ident.t * lambda * lambda
| Lmutlet of value_kind * Ident.t * lambda * lambda
| Lletrec of (Ident.t * lambda) list * lambda
| Lprim of primitive * lambda list * scoped_location
| Lswitch of lambda * lambda_switch * scoped_location
Expand Down
5 changes: 3 additions & 2 deletions lambda/matching.ml
View file
Open in desktop
Expand Up @@ -3549,6 +3549,7 @@ let simple_for_let ~scopes loc param pat body =

let rec map_return f = function
| Llet (str, k, id, l1, l2) -> Llet (str, k, id, l1, map_return f l2)
| Lmutlet (k, id, l1, l2) -> Lmutlet (k, id, l1, map_return f l2)
| Lletrec (l1, l2) -> Lletrec (l1, map_return f l2)
| Lifthenelse (lcond, lthen, lelse) ->
Lifthenelse (lcond, map_return f lthen, map_return f lelse)
Expand Down Expand Up @@ -3576,8 +3577,8 @@ let rec map_return f = function
Option.map (map_return f) def,
loc )
| (Lstaticraise _ | Lprim (Praise _, _, _)) as l -> l
| ( Lvar _ | Lconst _ | Lapply _ | Lfunction _ | Lsend _ | Lprim _ | Lwhile _
| Lfor _ | Lassign _ | Lifused _ ) as l ->
| ( Lvar _ | Lmutvar _ | Lconst _ | Lapply _ | Lfunction _ | Lsend _ | Lprim _
| Lwhile _ | Lfor _ | Lassign _ | Lifused _ ) as l ->
f l

(* The 'opt' reference indicates if the optimization is worthy.
Expand Down
26 changes: 18 additions & 8 deletions lambda/printlambda.ml
View file
Open in desktop
Expand Up @@ -495,6 +495,8 @@ let apply_specialised_attribute ppf = function
let rec lam ppf = function
| Lvar id ->
Ident.print ppf id
| Lmutvar id ->
fprintf ppf "*%a" Ident.print id
| Lconst cst ->
struct_const ppf cst
| Lapply ap ->
Expand Down Expand Up @@ -522,18 +524,26 @@ let rec lam ppf = function
fprintf ppf ")" in
fprintf ppf "@[<2>(function%a@ %a%a%a)@]" pr_params params
function_attribute attr return_kind return lam body
| Llet(str, k, id, arg, body) ->
let kind = function
Alias -> "a" | Strict -> "" | StrictOpt -> "o" | Variable -> "v"
| Llet(_, k, id, arg, body)
| Lmutlet(k, id, arg, body) as l ->
let let_kind = begin function
| Llet(str,_,_,_,_) ->
begin match str with
Alias -> "a" | Strict -> "" | StrictOpt -> "o"
end
| Lmutlet _ -> "mut"
| _ -> assert false
end
in
let rec letbody = function
| Llet(str, k, id, arg, body) ->
fprintf ppf "@ @[<2>%a =%s%a@ %a@]"
Ident.print id (kind str) value_kind k lam arg;
letbody body
| Llet(_, k, id, arg, body)
| Lmutlet(k, id, arg, body) as l ->
fprintf ppf "@ @[<2>%a =%s%a@ %a@]"
Ident.print id (let_kind l) value_kind k lam arg;
letbody body
| expr -> expr in
fprintf ppf "@[<2>(let@ @[<hv 1>(@[<2>%a =%s%a@ %a@]"
Ident.print id (kind str) value_kind k lam arg;
Ident.print id (let_kind l) value_kind k lam arg;
let expr = letbody body in
fprintf ppf ")@]@ %a)@]" lam expr
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Note: here I think the duplication is cumbersome, and could be avoided with a refactoring of the code (an auxiliary function or something).

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

You are right, I addressed that in 4600d47.

| Lletrec(id_arg_list, body) ->
Expand Down
44 changes: 31 additions & 13 deletions lambda/simplif.ml
View file
Open in desktop
Expand Up @@ -27,7 +27,7 @@ exception Real_reference
let rec eliminate_ref id = function
Lvar v as lam ->
if Ident.same v id then raise Real_reference else lam
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I believe that eliminate_ref is only called with pure variables id, so Ident.same v id is impossible in the Lmutvar case. Could you simplify the code with Lmutvar _ as lam -> lam directly?

| Lconst _ as lam -> lam
| Lmutvar _ | Lconst _ as lam -> lam
| Lapply ap ->
Lapply{ap with ap_func = eliminate_ref id ap.ap_func;
ap_args = List.map (eliminate_ref id) ap.ap_args}
Expand All @@ -37,15 +37,17 @@ let rec eliminate_ref id = function
else lam
| Llet(str, kind, v, e1, e2) ->
Llet(str, kind, v, eliminate_ref id e1, eliminate_ref id e2)
| Lmutlet(kind, v, e1, e2) ->
Lmutlet(kind, v, eliminate_ref id e1, eliminate_ref id e2)
| Lletrec(idel, e2) ->
Lletrec(List.map (fun (v, e) -> (v, eliminate_ref id e)) idel,
eliminate_ref id e2)
| Lprim(Pfield 0, [Lvar v], _) when Ident.same v id ->
Lvar id
Lmutvar id
| Lprim(Psetfield(0, _, _), [Lvar v; e], _) when Ident.same v id ->
Lassign(id, eliminate_ref id e)
| Lprim(Poffsetref delta, [Lvar v], loc) when Ident.same v id ->
Copy link
Contributor

@lthls lthls Jan 6, 2021 •
edited

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

There's a subtle bug remaining here (on the line below, but I can't put a comment there directly): Lvar id needs to become Lmutvar id. I missed this in my earlier review...

Lassign(id, Lprim(Poffsetint delta, [Lvar id], loc))
Lassign(id, Lprim(Poffsetint delta, [Lmutvar id], loc))
| Lprim(p, el, loc) ->
Lprim(p, List.map (eliminate_ref id) el, loc)
| Lswitch(e, sw, loc) ->
Expand Down Expand Up @@ -120,10 +122,11 @@ let simplify_exits lam =
in

let rec count = function
| (Lvar _| Lconst _) -> ()
| (Lvar _ | Lmutvar _ | Lconst _) -> ()
| Lapply ap -> count ap.ap_func; List.iter count ap.ap_args
| Lfunction {body} -> count body
| Llet(_str, _kind, _v, l1, l2) ->
| Llet(_, _kind, _v, l1, l2)
| Lmutlet(_kind, _v, l1, l2) ->
count l2; count l1
| Lletrec(bindings, body) ->
List.iter (fun (_v, l) -> count l) bindings;
Expand Down Expand Up @@ -203,13 +206,14 @@ let simplify_exits lam =
let subst = Hashtbl.create 17 in

let rec simplif = function
| (Lvar _|Lconst _) as l -> l
| (Lvar _ | Lmutvar _ | Lconst _) as l -> l
| Lapply ap ->
Lapply{ap with ap_func = simplif ap.ap_func;
ap_args = List.map simplif ap.ap_args}
| Lfunction{kind; params; return; body = l; attr; loc} ->
Lfunction{kind; params; return; body = simplif l; attr; loc}
| Llet(str, kind, v, l1, l2) -> Llet(str, kind, v, simplif l1, simplif l2)
| Lmutlet(kind, v, l1, l2) -> Lmutlet(kind, v, simplif l1, simplif l2)
| Lletrec(bindings, body) ->
Lletrec(List.map (fun (v, l) -> (v, simplif l)) bindings, simplif body)
| Lprim(p, ll, loc) -> begin
Expand Down Expand Up @@ -407,7 +411,8 @@ let simplify_lets lam =
let rec count bv = function
| Lconst _ -> ()
| Lvar v ->
use_var bv v 1
use_var bv v 1
| Lmutvar _ -> ()
| Lapply{ap_func = ll; ap_args = args} ->
let no_opt () = count bv ll; List.iter (count bv) args in
begin match ll with
Expand All @@ -430,6 +435,9 @@ let simplify_lets lam =
count (bind_var bv v) l2;
(* If v is unused, l1 will be removed, so don't count its variables *)
if str = Strict || count_var v > 0 then count bv l1
| Lmutlet(_kind, _v, l1, l2) ->
count bv l1;
count bv l2
| Lletrec(bindings, body) ->
List.iter (fun (_v, l) -> count bv l) bindings;
count bv body
Expand Down Expand Up @@ -491,10 +499,17 @@ let simplify_lets lam =
(* This (small) optimisation is always legal, it may uncover some
tail call later on. *)

let mklet str kind v e1 e2 = match e2 with
| Lvar w when optimize && Ident.same v w -> e1
| _ -> Llet (str, kind,v,e1,e2) in
let mklet str kind v e1 e2 =
match e2 with
| Lvar w when optimize && Ident.same v w -> e1
| _ -> Llet (str, kind,v,e1,e2)
in

let mkmutlet kind v e1 e2 =
match e2 with
| Lmutvar w when optimize && Ident.same v w -> e1
| _ -> Lmutlet (kind,v,e1,e2)
in
gasche marked this conversation as resolved.
Show resolved Hide resolved

let rec simplif = function
Lvar v as l ->
Expand All @@ -503,7 +518,7 @@ let simplify_lets lam =
with Not_found ->
l
end
| Lconst _ as l -> l
| Lmutvar _ | Lconst _ as l -> l
| Lapply ({ap_func = ll; ap_args = args} as ap) ->
let no_opt () =
Lapply {ap with ap_func = simplif ap.ap_func;
Expand Down Expand Up @@ -545,7 +560,7 @@ let simplify_lets lam =
| Some [field_kind] -> field_kind
| Some _ -> assert false
in
mklet Variable kind v slinit (eliminate_ref v slbody)
mkmutlet kind v slinit (eliminate_ref v slbody)
with Real_reference ->
mklet Strict kind v (Lprim(prim, [slinit], loc)) slbody
end
Expand All @@ -561,6 +576,7 @@ let simplify_lets lam =
| _ -> mklet StrictOpt kind v (simplif l1) (simplif l2)
end
| Llet(str, kind, v, l1, l2) -> mklet str kind v (simplif l1) (simplif l2)
| Lmutlet(kind, v, l1, l2) -> mkmutlet kind v (simplif l1) (simplif l2)
| Lletrec(bindings, body) ->
Lletrec(List.map (fun (v, l) -> (v, simplif l)) bindings, simplif body)
| Lprim(p, ll, loc) -> Lprim(p, List.map simplif ll, loc)
Expand Down Expand Up @@ -606,6 +622,7 @@ let simplify_lets lam =
let rec emit_tail_infos is_tail lambda =
match lambda with
| Lvar _ -> ()
| Lmutvar _ -> ()
| Lconst _ -> ()
| Lapply ap ->
begin
Expand All @@ -629,7 +646,8 @@ let rec emit_tail_infos is_tail lambda =
list_emit_tail_infos false ap.ap_args
| Lfunction {body = lam} ->
emit_tail_infos true lam
| Llet (_str, _k, _, lam, body) ->
| Llet (_, _k, _, lam, body)
| Lmutlet (_k, _, lam, body) ->
emit_tail_infos false lam;
emit_tail_infos is_tail body
| Lletrec (bindings, body) ->
Expand Down