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

Changes in simplif.ml - removal of try_depth ref #9827

Merged
merged 5 commits into from
Apr 7, 2021
Merged

Changes in simplif.ml - removal of try_depth ref #9827

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
c7b22fa
Removed last commit
Anukriti12 Jun 22, 2020
27be20c
made try_depth a labeled argument
Anukriti12 Jun 22, 2020
55db065
Rebase fix + small style fixes
lthls Mar 31, 2021
01785c0
Changes + long lines
lthls Mar 31, 2021
e1f884d
Update Changes with full name
lthls Mar 31, 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
3 changes: 3 additions & 0 deletions Changes
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -207,6 +207,9 @@ Working version
- #9650, #9651: keep refactoring the pattern-matching compiler
(Gabriel Scherer, review by Thomas Refis and Florian Angeletti)

- #9827: Replace references with functions arguments in Simplif
(Anukriti Kumar, review by Vincent Laviron and David Allsop)

- #9994: Make Types.type_expr a private type, and abstract marking mechanism
(Jacques Garrigue and Takafumi Saikawa,
review by Gabriel Scherer and Leo White)
Expand Down
168 changes: 92 additions & 76 deletions lambda/simplif.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -105,8 +105,6 @@ let simplify_exits lam =
(* Count occurrences of (exit n ...) statements *)
let exits = Hashtbl.create 17 in

let try_depth = ref 0 in

let get_exit i =
try Hashtbl.find exits i
with Not_found -> {count = 0; max_depth = 0}
Expand All @@ -121,70 +119,82 @@ let simplify_exits lam =
Hashtbl.add exits i r
in

let rec count = function
| (Lvar _ | Lmutvar _ | Lconst _) -> ()
| Lapply ap -> count ap.ap_func; List.iter count ap.ap_args
| Lfunction {body} -> count body
let rec count ~try_depth = function
| (Lvar _| Lmutvar _ | Lconst _) -> ()
| Lapply ap ->
count ~try_depth ap.ap_func;
List.iter (count ~try_depth) ap.ap_args
| Lfunction {body} -> count ~try_depth body
| Llet(_, _kind, _v, l1, l2)
| Lmutlet(_kind, _v, l1, l2) ->
count l2; count l1
count ~try_depth l2; count ~try_depth l1
| Lletrec(bindings, body) ->
List.iter (fun (_v, l) -> count l) bindings;
count body
| Lprim(_p, ll, _) -> List.iter count ll
List.iter (fun (_v, l) -> count ~try_depth l) bindings;
count ~try_depth body
| Lprim(_p, ll, _) -> List.iter (count ~try_depth) ll
| Lswitch(l, sw, _loc) ->
count_default sw ;
count l;
List.iter (fun (_, l) -> count l) sw.sw_consts;
List.iter (fun (_, l) -> count l) sw.sw_blocks
count_default ~try_depth sw ;
count ~try_depth l;
List.iter (fun (_, l) -> count ~try_depth l) sw.sw_consts;
List.iter (fun (_, l) -> count ~try_depth l) sw.sw_blocks
| Lstringswitch(l, sw, d, _) ->
count l;
List.iter (fun (_, l) -> count l) sw;
count ~try_depth l;
List.iter (fun (_, l) -> count ~try_depth l) sw;
begin match d with
| None -> ()
| Some d -> match sw with
| []|[_] -> count d
| _ -> count d; count d (* default will get replicated *)
| []|[_] -> count ~try_depth d
| _ -> (* default will get replicated *)
count ~try_depth d; count ~try_depth d
end
| Lstaticraise (i,ls) -> incr_exit i 1 !try_depth; List.iter count ls
| Lstaticraise (i,ls) ->
incr_exit i 1 try_depth;
List.iter (count ~try_depth) ls
| Lstaticcatch (l1,(i,[]),Lstaticraise (j,[])) ->
(* i will be replaced by j in l1, so each occurrence of i in l1
increases j's ref count *)
count l1 ;
count ~try_depth l1 ;
let ic = get_exit i in
incr_exit j ic.count (max !try_depth ic.max_depth)
incr_exit j ic.count (max try_depth ic.max_depth)
| Lstaticcatch(l1, (i,_), l2) ->
count l1;
count ~try_depth l1;
(* If l1 does not contain (exit i),
l2 will be removed, so don't count its exits *)
if (get_exit i).count > 0 then
count l2
| Ltrywith(l1, _v, l2) -> incr try_depth; count l1; decr try_depth; count l2
| Lifthenelse(l1, l2, l3) -> count l1; count l2; count l3
| Lsequence(l1, l2) -> count l1; count l2
| Lwhile(l1, l2) -> count l1; count l2
| Lfor(_, l1, l2, _dir, l3) -> count l1; count l2; count l3
| Lassign(_v, l) -> count l
| Lsend(_k, m, o, ll, _) -> List.iter count (m::o::ll)
| Levent(l, _) -> count l
| Lifused(_v, l) -> count l

and count_default sw = match sw.sw_failaction with
count ~try_depth l2
| Ltrywith(l1, _v, l2) ->
count ~try_depth:(try_depth+1) l1;
count ~try_depth l2;
| Lifthenelse(l1, l2, l3) ->
count ~try_depth l1;
count ~try_depth l2;
count ~try_depth l3
| Lsequence(l1, l2) -> count ~try_depth l1; count ~try_depth l2
| Lwhile(l1, l2) -> count ~try_depth l1; count ~try_depth l2
| Lfor(_, l1, l2, _dir, l3) ->
count ~try_depth l1;
count ~try_depth l2;
count ~try_depth l3
| Lassign(_v, l) -> count ~try_depth l
| Lsend(_k, m, o, ll, _) -> List.iter (count ~try_depth) (m::o::ll)
| Levent(l, _) -> count ~try_depth l
| Lifused(_v, l) -> count ~try_depth l

and count_default ~try_depth sw = match sw.sw_failaction with
| None -> ()
| Some al ->
let nconsts = List.length sw.sw_consts
and nblocks = List.length sw.sw_blocks in
if
nconsts < sw.sw_numconsts && nblocks < sw.sw_numblocks
then begin (* default action will occur twice in native code *)
count al ; count al
count ~try_depth al ; count ~try_depth al
end else begin (* default action will occur once *)
assert (nconsts < sw.sw_numconsts || nblocks < sw.sw_numblocks) ;
count al
count ~try_depth al
end
in
count lam;
assert(!try_depth = 0);
count ~try_depth:0 lam;

(*
Second pass simplify ``catch body with (i ...) handler''
Expand All @@ -204,20 +214,22 @@ let simplify_exits lam =
*)

let subst = Hashtbl.create 17 in

let rec simplif = function
| (Lvar _ | Lmutvar _ | Lconst _) as l -> l
let rec simplif ~try_depth = function
| (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}
Lapply{ap with ap_func = simplif ~try_depth ap.ap_func;
ap_args = List.map (simplif ~try_depth) 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)
Lfunction{kind; params; return; body = simplif ~try_depth l; attr; loc}
| Llet(str, kind, v, l1, l2) ->
Llet(str, kind, v, simplif ~try_depth l1, simplif ~try_depth l2)
| Lmutlet(kind, v, l1, l2) ->
Lmutlet(kind, v, simplif ~try_depth l1, simplif ~try_depth l2)
| Lletrec(bindings, body) ->
Lletrec(List.map (fun (v, l) -> (v, simplif l)) bindings, simplif body)
Lletrec(List.map (fun (v, l) -> (v, simplif ~try_depth l)) bindings,
simplif ~try_depth body)
| Lprim(p, ll, loc) -> begin
let ll = List.map simplif ll in
let ll = List.map (simplif ~try_depth) ll in
match p, ll with
(* Simplify %revapply, for n-ary functions with n > 1 *)
| Prevapply, [x; Lapply ap]
Expand Down Expand Up @@ -261,19 +273,21 @@ let simplify_exits lam =
| _ -> Lprim(p, ll, loc)
end
| Lswitch(l, sw, loc) ->
let new_l = simplif l
and new_consts = List.map (fun (n, e) -> (n, simplif e)) sw.sw_consts
and new_blocks = List.map (fun (n, e) -> (n, simplif e)) sw.sw_blocks
and new_fail = Option.map simplif sw.sw_failaction in
let new_l = simplif ~try_depth l
and new_consts =
List.map (fun (n, e) -> (n, simplif ~try_depth e)) sw.sw_consts
and new_blocks =
List.map (fun (n, e) -> (n, simplif ~try_depth e)) sw.sw_blocks
and new_fail = Option.map (simplif ~try_depth) sw.sw_failaction in
Lswitch
(new_l,
{sw with sw_consts = new_consts ; sw_blocks = new_blocks;
sw_failaction = new_fail},
loc)
| Lstringswitch(l,sw,d,loc) ->
Lstringswitch
(simplif l,List.map (fun (s,l) -> s,simplif l) sw,
Option.map simplif d,loc)
(simplif ~try_depth l,List.map (fun (s,l) -> s,simplif ~try_depth l) sw,
Option.map (simplif ~try_depth) d,loc)
| Lstaticraise (i,[]) as l ->
begin try
let _,handler = Hashtbl.find subst i in
Expand All @@ -282,7 +296,7 @@ let simplify_exits lam =
| Not_found -> l
end
| Lstaticraise (i,ls) ->
let ls = List.map simplif ls in
let ls = List.map (simplif ~try_depth) ls in
begin try
let xs,handler = Hashtbl.find subst i in
let ys = List.map (fun (x, k) -> Ident.rename x, k) xs in
Expand All @@ -304,38 +318,40 @@ let simplify_exits lam =
| Not_found -> Lstaticraise (i,ls)
end
| Lstaticcatch (l1,(i,[]),(Lstaticraise (_j,[]) as l2)) ->
Hashtbl.add subst i ([],simplif l2) ;
simplif l1
Hashtbl.add subst i ([],simplif ~try_depth l2) ;
simplif ~try_depth l1
| Lstaticcatch (l1,(i,xs),l2) ->
let {count; max_depth} = get_exit i in
if count = 0 then
(* Discard staticcatch: not matching exit *)
simplif l1
else if count = 1 && max_depth <= !try_depth then begin
simplif ~try_depth l1
else if
count = 1 && max_depth <= try_depth then begin
(* Inline handler if there is a single occurrence and it is not
nested within an inner try..with *)
assert(max_depth = !try_depth);
Hashtbl.add subst i (xs,simplif l2);
simplif l1
assert(max_depth = try_depth);
Hashtbl.add subst i (xs,simplif ~try_depth l2);
simplif ~try_depth l1
end else
Lstaticcatch (simplif l1, (i,xs), simplif l2)
Lstaticcatch (simplif ~try_depth l1, (i,xs), simplif ~try_depth l2)
| Ltrywith(l1, v, l2) ->
incr try_depth;
let l1 = simplif l1 in
decr try_depth;
Ltrywith(l1, v, simplif l2)
| Lifthenelse(l1, l2, l3) -> Lifthenelse(simplif l1, simplif l2, simplif l3)
| Lsequence(l1, l2) -> Lsequence(simplif l1, simplif l2)
| Lwhile(l1, l2) -> Lwhile(simplif l1, simplif l2)
let l1 = simplif ~try_depth:(try_depth + 1) l1 in
Ltrywith(l1, v, simplif ~try_depth l2)
| Lifthenelse(l1, l2, l3) -> Lifthenelse(simplif ~try_depth l1,
simplif ~try_depth l2, simplif ~try_depth l3)
| Lsequence(l1, l2) -> Lsequence(simplif ~try_depth l1, simplif ~try_depth l2)
| Lwhile(l1, l2) -> Lwhile(simplif ~try_depth l1, simplif ~try_depth l2)
| Lfor(v, l1, l2, dir, l3) ->
Lfor(v, simplif l1, simplif l2, dir, simplif l3)
| Lassign(v, l) -> Lassign(v, simplif l)
Lfor(v, simplif ~try_depth l1, simplif ~try_depth l2, dir,
simplif ~try_depth l3)
| Lassign(v, l) -> Lassign(v, simplif ~try_depth l)
| Lsend(k, m, o, ll, loc) ->
Lsend(k, simplif m, simplif o, List.map simplif ll, loc)
| Levent(l, ev) -> Levent(simplif l, ev)
| Lifused(v, l) -> Lifused (v,simplif l)
Lsend(k, simplif ~try_depth m, simplif ~try_depth o,
List.map (simplif ~try_depth) ll, loc)
| Levent(l, ev) -> Levent(simplif ~try_depth l, ev)
| Lifused(v, l) -> Lifused (v,simplif ~try_depth l)
in
simplif lam
simplif ~try_depth:0 lam

(* Compile-time beta-reduction of functions immediately applied:
Lapply(Lfunction(Curried, params, body), args, loc) ->
Expand Down