Movatterモバイル変換

[0]ホーム
URL:

Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly

 Sign up
Appearance settings

Commit9202879

Browse files
committed
Implement typed Option stdlib optimizations
1 parentf1692ff commit9202879

19 files changed

+375
-231
lines changed

‎compiler/frontend/ast_option_optimizations.ml‎

Lines changed: 0 additions & 126 deletions
This file was deleted.

‎compiler/frontend/ast_option_optimizations.mli‎

Lines changed: 0 additions & 1 deletion
This file was deleted.

‎compiler/frontend/bs_builtin_ppx.ml‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -112,8 +112,7 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
112112
body;
113113
pexp_attributes;
114114
})
115-
|Pexp_apply_ ->
116-
Ast_exp_apply.app_exp_mapper e self|>Ast_option_optimizations.transform
115+
|Pexp_apply_ ->Ast_exp_apply.app_exp_mapper e self
117116
|Pexp_match
118117
( b,
119118
[

‎compiler/ml/printtyped.ml‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -260,6 +260,15 @@ and expression_extra i ppf x attrs =
260260
|Texp_newtypes ->
261261
line i ppf"Texp_newtype\"%s\"\n" s;
262262
attributes i ppf attrs
263+
|Texp_stdlib_option_call{call_kind; _} ->
264+
let kind=
265+
match call_kindwith
266+
|Stdlib_option_forEach ->"forEach"
267+
|Stdlib_option_map{result_cannot_contain_undefined =_} ->"map"
268+
|Stdlib_option_flatMap ->"flatMap"
269+
in
270+
line i ppf"Texp_stdlib_option_call %s\n" kind;
271+
attributes i ppf attrs
263272

264273
andexpressionippfx=
265274
line i ppf"expression %a\n" fmt_location x.exp_loc;

‎compiler/ml/tast_iterator.ml‎

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -137,11 +137,16 @@ let pat sub {pat_extra; pat_desc; pat_env; _} =
137137
|Tpat_alias (p,_,_) -> sub.pat sub p
138138

139139
letexprsub{exp_extra; exp_desc; exp_env; _}=
140-
letextra=function
140+
letrecextra=function
141141
|Texp_constraintcty -> sub.typ sub cty
142142
|Texp_coercecty2 -> sub.typ sub cty2
143143
|Texp_newtype_ ->()
144144
|Texp_open (_,_,_,_) ->()
145+
|Texp_stdlib_option_callinfo -> stdlib_option_call info
146+
andstdlib_option_call{callback; _}= stdlib_option_callback callback
147+
andstdlib_option_callback=function
148+
|Stdlib_option_inline_lambda{body; _} -> sub.expr sub body
149+
|Stdlib_option_inline_identexpr -> sub.expr sub expr
145150
in
146151
List.iter (fun (e,_,_) -> extra e) exp_extra;
147152
sub.env sub exp_env;

‎compiler/ml/tast_mapper.ml‎

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -180,12 +180,23 @@ let pat sub x =
180180
{xwith pat_extra; pat_desc; pat_env}
181181

182182
letexprsubx=
183+
letmap_stdlib_option_callbacksub=function
184+
|Stdlib_option_inline_lambda{param; body} ->
185+
Stdlib_option_inline_lambda {param; body= sub.expr sub body}
186+
|Stdlib_option_inline_identexpr ->
187+
Stdlib_option_inline_ident (sub.expr sub expr)
188+
in
189+
letmap_stdlib_option_callsub{callback; call_kind}=
190+
{callback= map_stdlib_option_callback sub callback; call_kind}
191+
in
183192
letextra=function
184193
|Texp_constraintcty ->Texp_constraint (sub.typ sub cty)
185194
|Texp_coercecty2 ->Texp_coerce (sub.typ sub cty2)
186195
|Texp_open (ovf,path,loc,env) ->
187196
Texp_open (ovf, path, loc, sub.env sub env)
188197
|Texp_newtype_asd -> d
198+
|Texp_stdlib_option_callinfo ->
199+
Texp_stdlib_option_call (map_stdlib_option_call sub info)
189200
in
190201
let exp_extra=List.map (tuple3 extra id id) x.exp_extrain
191202
let exp_env= sub.env sub x.exp_envin

‎compiler/ml/translcore.ml‎

Lines changed: 70 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -646,6 +646,16 @@ let rec cut n l =
646646

647647
let try_ids=Hashtbl.create8
648648

649+
letstdlib_option_call_extraexp=
650+
letrecaux=function
651+
|[] ->None
652+
| (Texp_stdlib_option_callinfo,_,_) ::_ ->Some info
653+
|_ ::rest -> aux rest
654+
in
655+
aux exp.exp_extra
656+
657+
let lambda_none=Lconst (Const_pointer (0,Pt_shape_none))
658+
649659
letextract_directive_for_fnexp=
650660
exp.exp_attributes
651661
|>List.find_map (fun ({txt},payload) ->
@@ -755,10 +765,11 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.lambda =
755765
(Lprim
756766
(Pccall (set_transformed_jsx d~transformed_jsx), argl, e.exp_loc))
757767
|_ -> wrap (Lprim (prim, argl, e.exp_loc))))
758-
|Texp_apply{funct;args =oargs; partial; transformed_jsx} ->
768+
|Texp_apply{funct;args =oargs; partial; transformed_jsx} -> (
759769
let inlined, funct=
760770
Translattribute.get_and_remove_inlined_attribute funct
761771
in
772+
let option_call_info= stdlib_option_call_extra ein
762773
let uncurried_partial_application=
763774
(* In case of partial application foo(args, ...) when some args are missing,
764775
get the arity*)
@@ -771,8 +782,17 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.lambda =
771782
|None ->None
772783
elseNone
773784
in
774-
transl_apply~inlined~uncurried_partial_application~transformed_jsx
775-
(transl_exp funct) oargs e.exp_loc
785+
match option_call_infowith
786+
|Someinfowhennot partial -> (
787+
match oargswith
788+
| (Nolabel, Someopt_expr) ::_ ->
789+
transl_stdlib_option_call e opt_expr info oargs
790+
|_ ->
791+
transl_apply~inlined~uncurried_partial_application~transformed_jsx
792+
(transl_exp funct) oargs e.exp_loc)
793+
|_ ->
794+
transl_apply~inlined~uncurried_partial_application~transformed_jsx
795+
(transl_exp funct) oargs e.exp_loc)
776796
|Texp_match (arg,pat_expr_list,exn_pat_expr_list,partial) ->
777797
transl_match e arg pat_expr_list exn_pat_expr_list partial
778798
|Texp_try (body,pat_expr_list) ->
@@ -924,6 +944,53 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.lambda =
924944
if!Clflags.noassertthen lambda_unit
925945
elseLifthenelse (transl_exp cond, lambda_unit, assert_failed e)
926946

947+
andbind_option_valueopt_varopt_loccallback=
948+
let value_expr=Lprim (Pval_from_option, [opt_var], opt_loc)in
949+
match callbackwith
950+
|Stdlib_option_inline_lambda{param; body} ->
951+
bindStrict param value_expr (transl_exp body)
952+
|Stdlib_option_inline_identexpr ->
953+
let func= transl_exp exprin
954+
let value_id=Ident.create"__res_option_value"in
955+
let apply=
956+
Lapply
957+
{
958+
ap_func= func;
959+
ap_args= [Lvar value_id];
960+
ap_inlined=Default_inline;
961+
ap_loc= expr.exp_loc;
962+
ap_transformed_jsx=false;
963+
}
964+
in
965+
bindStrict value_id value_expr apply
966+
967+
andtransl_stdlib_option_callexpopt_exprinfooargs=
968+
match oargswith
969+
| (Nolabel,Some_) :: (Nolabel,Some_) ::_| (Nolabel, Some_) ::[] ->
970+
let opt_lam= transl_exp opt_exprin
971+
let opt_id=Ident.create"__res_option_opt"in
972+
let opt_var=Lvar opt_idin
973+
let callback_result= bind_option_value opt_var exp.exp_loc info.callbackin
974+
let some_branch=
975+
match info.call_kindwith
976+
|Stdlib_option_forEach -> callback_result
977+
|Stdlib_option_map{result_cannot_contain_undefined} ->
978+
let tag=
979+
if result_cannot_contain_undefinedthenBlk_some_not_nested
980+
elseBlk_some
981+
in
982+
Lprim (Pmakeblock tag, [callback_result], exp.exp_loc)
983+
|Stdlib_option_flatMap -> callback_result
984+
in
985+
let none_branch=
986+
match info.call_kindwith
987+
|Stdlib_option_forEach -> lambda_unit
988+
|Stdlib_option_map_|Stdlib_option_flatMap -> lambda_none
989+
in
990+
let cond=Lprim (Pis_not_none, [opt_var], exp.exp_loc)in
991+
bindStrict opt_id opt_lam (Lifthenelse (cond, some_branch, none_branch))
992+
|_ ->assertfalse
993+
927994
andtransl_listexpr_list=List.map transl_exp expr_list
928995

929996
andtransl_guardguardrhs=

0 commit comments

Comments
 (0)
[8]ページ先頭
©2009-2025 Movatter.jp