Skip to content

Commit f876877

Browse files
authored
flambda-backend: Syntactic function arity typechecking and translation (#1817)
* Newtypes * Constraint/coercion * Add map_half_typed_cases * Implement type-checking/translation This also promotes tests whose output changes. * Add upstream tests Tests from: - ocaml/ocaml#12236 (and the corresponding updates to outputs found in ocaml/ocaml#12386 and ocaml/ocaml#12391) - ocaml/ocaml#12496 (not merged) * Fix ocamldoc * Update chamelon minimizer * Respond to requested changes to minimizer * update new test brought in from rebase * Fix bug in chunking code * `make bootstrap` * Add Ast_invariant check * Fix type-directed disambiguation of optional arg defaults * Minor comments from review * Run syntactic-arity test, update output, and fix printing bug * Remove unnecessary call to escape * Backport changes from upstream to comparative alloc tests * Avoid the confusing [Split_function_ty] module * Comment [split_function_ty] better. * [contains_gadt] as variant instead of bool * Calculate is_final_val_param on the fly rather than precomputing indexes * Note suboptimality * Get typecore typechecking * Finish resolving merge conflicts and run tests * make bootstrap * Add iteration on / mapping over locations and attributes * Reduce diff and fix typo in comment: * promote change to zero-alloc arg structure * Undo unintentional formatting changes to chamelon * Fix minimizer * Minimize diff * Fix bug with local-returning method * Fix regression where polymorphic parameters weren't allowed to be used in same parameter list as GADTs * Fix merge conflicts and make bootstrap * Apply expected diff to zero-alloc test changed in this PR
1 parent 56067cc commit f876877

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

63 files changed

+3780
-1521
lines changed

boot/ocamlc

8.39 KB
Binary file not shown.

boot/ocamllex

-148 Bytes
Binary file not shown.

lambda/.ocamlformat-enable

Whitespace-only changes.

lambda/lambda.ml

Lines changed: 12 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -547,7 +547,9 @@ type loop_attribute =
547547
| Never_loop (* [@loop never] *)
548548
| Default_loop (* no [@loop] attribute *)
549549

550-
type function_kind = Curried of {nlocal: int} | Tupled
550+
type curried_function_kind = { nlocal : int } [@@unboxed]
551+
552+
type function_kind = Curried of curried_function_kind | Tupled
551553

552554
type let_kind = Strict | Alias | StrictOpt
553555

@@ -575,6 +577,7 @@ type function_attribute = {
575577
is_opaque: bool;
576578
stub: bool;
577579
tmc_candidate: bool;
580+
may_fuse_arity: bool;
578581
}
579582

580583
type scoped_location = Debuginfo.Scoped_location.t
@@ -768,6 +771,14 @@ let default_function_attribute = {
768771
is_opaque = false;
769772
stub = false;
770773
tmc_candidate = false;
774+
(* Plain functions ([fun] and [function]) set [may_fuse_arity] to [false] so
775+
that runtime arity matches syntactic arity in more situations.
776+
Many things compile to functions without having a notion of syntactic arity
777+
that survives typechecking, e.g. functors. Multi-arg functors are compiled
778+
as nested unary functions, and rely on the arity fusion in simplif to make
779+
them multi-argument. So, we keep arity fusion turned on by default for now.
780+
*)
781+
may_fuse_arity = true;
771782
}
772783

773784
let default_stub_attribute =

lambda/lambda.mli

Lines changed: 8 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -436,10 +436,12 @@ type loop_attribute =
436436
| Never_loop (* [@loop never] *)
437437
| Default_loop (* no [@loop] attribute *)
438438

439-
type function_kind = Curried of {nlocal: int} | Tupled
439+
type curried_function_kind = { nlocal: int } [@@unboxed]
440440
(* [nlocal] determines how many arguments may be partially applied
441-
before the resulting closure must be locally allocated.
442-
See [lfunction] for details *)
441+
before the resulting closure must be locally allocated.
442+
See [lfunction] for details *)
443+
444+
type function_kind = Curried of curried_function_kind | Tupled
443445

444446
type let_kind = Strict | Alias | StrictOpt
445447
(* Meaning of kinds for let x = e in e':
@@ -471,6 +473,9 @@ type function_attribute = {
471473
is_opaque: bool;
472474
stub: bool;
473475
tmc_candidate: bool;
476+
(* [may_fuse_arity] is true if [simplif.ml] is permitted to fuse arity, i.e.,
477+
to perform the rewrite [fun x -> fun y -> e] to [fun x y -> e] *)
478+
may_fuse_arity: bool;
474479
}
475480

476481
type parameter_attribute = No_attributes

lambda/matching.ml

Lines changed: 41 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -2950,6 +2950,18 @@ let split_extension_cases tag_lambda_list =
29502950
| _, Ordinary _ -> assert false)
29512951
tag_lambda_list
29522952

2953+
let transl_match_on_option value_kind arg loc ~if_some ~if_none =
2954+
(* This case is very frequent, it corresponds to
2955+
options and lists. *)
2956+
(* Keeping the Pisint test would make the bytecode
2957+
slightly worse, but it lets the native compiler generate
2958+
better code -- see #10681. *)
2959+
if !Clflags.native_code then
2960+
Lifthenelse(Lprim (Pisint { variant_only = true }, [ arg ], loc),
2961+
if_none, if_some, value_kind)
2962+
else
2963+
Lifthenelse(arg, if_some, if_none, value_kind)
2964+
29532965
let combine_constructor value_kind loc arg pat_env cstr partial ctx def
29542966
(descr_lambda_list, total1, pats) =
29552967
match cstr.cstr_tag with
@@ -3042,16 +3054,8 @@ let combine_constructor value_kind loc arg pat_env cstr partial ctx def
30423054
with
30433055
| 1, 1, [ (0, act1) ], [ (0, act2) ]
30443056
when not (Clflags.is_flambda2 ()) ->
3045-
(* This case is very frequent, it corresponds to
3046-
options and lists. *)
3047-
(* Keeping the Pisint test would make the bytecode
3048-
slightly worse, but it lets the native compiler generate
3049-
better code -- see #10681. *)
3050-
if !Clflags.native_code then
3051-
Lifthenelse(Lprim (Pisint { variant_only = true }, [ arg ], loc),
3052-
act1, act2, value_kind)
3053-
else
3054-
Lifthenelse(arg, act2, act1, value_kind)
3057+
transl_match_on_option value_kind arg loc
3058+
~if_none:act1 ~if_some:act2
30553059
| n, 0, _, [] ->
30563060
(* The matched type defines constant constructors only.
30573061
(typically the constant cases are dense, so
@@ -4109,6 +4113,33 @@ let for_multiple_match ~scopes ~return_layout loc paraml mode pat_act_list parti
41094113
(do_for_multiple_match ~scopes ~return_layout loc paraml mode pat_act_list
41104114
partial)
41114115

4116+
let for_optional_arg_default
4117+
~scopes loc pat ~param ~default_arg ~default_arg_sort ~return_layout body
4118+
: lambda
4119+
=
4120+
(* CR layouts v1.5: It's sad to compute [default_arg_layout] here as we
4121+
immediately go and do it again in [for_let]. We should rework [for_let]
4122+
so it can take a precomputed layout.
4123+
*)
4124+
let default_arg_layout =
4125+
Typeopt.layout pat.pat_env pat.pat_loc default_arg_sort pat.pat_type
4126+
in
4127+
let supplied_or_default =
4128+
transl_match_on_option
4129+
default_arg_layout
4130+
(Lvar param)
4131+
Loc_unknown
4132+
~if_none:default_arg
4133+
~if_some:
4134+
(Lprim
4135+
(* CR ncik-roberts: Check whether we need something better here. *)
4136+
(Pfield (0, Pointer, Reads_agree),
4137+
[ Lvar param ],
4138+
Loc_unknown))
4139+
in
4140+
for_let ~scopes ~arg_sort:default_arg_sort ~return_layout
4141+
loc supplied_or_default pat body
4142+
41124143
(* Error report *)
41134144
(* CR layouts v5: This file didn't use to have the report_error infrastructure -
41144145
I added it only for the void sanity checking in this module, which I'm not

lambda/matching.mli

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -45,6 +45,21 @@ val for_tupled_function:
4545
Ident.t list -> (pattern list * lambda) list -> partial ->
4646
lambda
4747

48+
(** [for_optional_arg_default pat body ~default_arg ~param] is:
49+
{[
50+
let $pat =
51+
match $param with
52+
| Some x -> x
53+
| None -> $default_arg
54+
in
55+
$body
56+
]}
57+
*)
58+
val for_optional_arg_default:
59+
scopes:scopes -> Location.t -> pattern -> param:Ident.t ->
60+
default_arg:lambda -> default_arg_sort:Jkind.sort ->
61+
return_layout:layout -> lambda -> lambda
62+
4863
exception Cannot_flatten
4964

5065
val flatten_pattern: int -> pattern -> pattern list

lambda/simplif.ml

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -555,13 +555,14 @@ let simplify_lets lam =
555555
| _ -> no_opt ()
556556
end
557557
| Lfunction{kind=outer_kind; params; return=outer_return; body = l;
558-
attr; loc; ret_mode; mode; region=outer_region} ->
558+
attr=attr1; loc; ret_mode; mode; region=outer_region} ->
559559
begin match outer_kind, outer_region, simplif l with
560560
Curried {nlocal=0},
561561
true,
562562
Lfunction{kind=Curried _ as kind; params=params'; return=return2;
563-
body; attr; loc; mode=inner_mode; ret_mode; region}
563+
body; attr=attr2; loc; mode=inner_mode; ret_mode; region}
564564
when optimize &&
565+
attr1.may_fuse_arity && attr2.may_fuse_arity &&
565566
List.length params + List.length params' <= Lambda.max_arity() ->
566567
(* The returned function's mode should match the outer return mode *)
567568
assert (is_heap_mode inner_mode);
@@ -570,9 +571,9 @@ let simplify_lets lam =
570571
type of the merged function taking [params @ params'] as
571572
parameters is the type returned after applying [params']. *)
572573
let return = return2 in
573-
lfunction ~kind ~params:(params @ params') ~return ~body ~attr ~loc ~mode ~ret_mode ~region
574+
lfunction ~kind ~params:(params @ params') ~return ~body ~attr:attr1 ~loc ~mode ~ret_mode ~region
574575
| kind, region, body ->
575-
lfunction ~kind ~params ~return:outer_return ~body ~attr ~loc ~mode ~ret_mode ~region
576+
lfunction ~kind ~params ~return:outer_return ~body ~attr:attr1 ~loc ~mode ~ret_mode ~region
576577
end
577578
| Llet(_str, _k, v, Lvar w, l2) when optimize ->
578579
Hashtbl.add subst v (simplif (Lvar w));

lambda/tmc.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1006,9 +1006,9 @@ and traverse_binding outer_ctx inner_ctx (var, def) =
10061006
match lfun.mode, lfun.kind with
10071007
| Alloc_heap, Tupled ->
10081008
(* Support of Tupled function: see [choice_apply]. *)
1009-
Curried {nlocal=0}
1009+
Curried {nlocal=0}
10101010
| Alloc_local, (Tupled | Curried _) ->
1011-
Curried {nlocal=List.length params}
1011+
Curried {nlocal=List.length params}
10121012
| Alloc_heap, (Curried _ as k) ->
10131013
(* Prepending arguments does not affect nlocal *)
10141014
k

0 commit comments

Comments
 (0)