Skip to content

Commit c4e17b0

Browse files
riaqnriaqn
authored
Replace var with local for faster mode checking (#53)
* refactoring modes logic * replaces var with local for faster mode checking (including in mode crossing) * lock in env is now alloc_mode * add exact to expected_mode so now type_function is sensible * fix tests * more comments * suspected bug is not a bug * fix the bug * revise per review * better checking for local returning functions
1 parent 6d477d8 commit c4e17b0

File tree

9 files changed

+181
-153
lines changed

9 files changed

+181
-153
lines changed

‎testsuite/tests/formatting/test_locations.dlocations.ocamlc.reference

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -105,7 +105,7 @@ let rec fib = function | 0 | 1 -> 1 | n -> (fib (n - 1)) + (fib (n - 2))
105105
<case>
106106
pattern (test_locations.ml[19,572+4]..test_locations.ml[19,572+5])
107107
Tpat_var "n"
108-
alloc_mode <modevar>
108+
alloc_mode global
109109
expression (test_locations.ml[19,572+9]..test_locations.ml[19,572+34])
110110
Texp_apply
111111
apply_mode Tail
@@ -118,7 +118,7 @@ let rec fib = function | 0 | 1 -> 1 | n -> (fib (n - 1)) + (fib (n - 2))
118118
expression (test_locations.ml[19,572+9]..test_locations.ml[19,572+20])
119119
Texp_apply
120120
apply_mode Default
121-
alloc_mode <modevar>
121+
alloc_mode global
122122
expression (test_locations.ml[19,572+9]..test_locations.ml[19,572+12])
123123
Texp_ident "fib"
124124
[
@@ -127,7 +127,7 @@ let rec fib = function | 0 | 1 -> 1 | n -> (fib (n - 1)) + (fib (n - 2))
127127
expression (test_locations.ml[19,572+13]..test_locations.ml[19,572+20])
128128
Texp_apply
129129
apply_mode Default
130-
alloc_mode <modevar>
130+
alloc_mode global
131131
expression (test_locations.ml[19,572+16]..test_locations.ml[19,572+17])
132132
Texp_ident "Stdlib!.-"
133133
[
@@ -146,7 +146,7 @@ let rec fib = function | 0 | 1 -> 1 | n -> (fib (n - 1)) + (fib (n - 2))
146146
expression (test_locations.ml[19,572+23]..test_locations.ml[19,572+34])
147147
Texp_apply
148148
apply_mode Default
149-
alloc_mode <modevar>
149+
alloc_mode global
150150
expression (test_locations.ml[19,572+23]..test_locations.ml[19,572+26])
151151
Texp_ident "fib"
152152
[
@@ -155,7 +155,7 @@ let rec fib = function | 0 | 1 -> 1 | n -> (fib (n - 1)) + (fib (n - 2))
155155
expression (test_locations.ml[19,572+27]..test_locations.ml[19,572+34])
156156
Texp_apply
157157
apply_mode Default
158-
alloc_mode <modevar>
158+
alloc_mode global
159159
expression (test_locations.ml[19,572+30]..test_locations.ml[19,572+31])
160160
Texp_ident "Stdlib!.-"
161161
[

‎testsuite/tests/formatting/test_locations.dno-locations.ocamlc.reference

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -105,7 +105,7 @@ let rec fib = function | 0 | 1 -> 1 | n -> (fib (n - 1)) + (fib (n - 2))
105105
<case>
106106
pattern
107107
Tpat_var "n"
108-
alloc_mode <modevar>
108+
alloc_mode global
109109
expression
110110
Texp_apply
111111
apply_mode Tail
@@ -118,7 +118,7 @@ let rec fib = function | 0 | 1 -> 1 | n -> (fib (n - 1)) + (fib (n - 2))
118118
expression
119119
Texp_apply
120120
apply_mode Default
121-
alloc_mode <modevar>
121+
alloc_mode global
122122
expression
123123
Texp_ident "fib"
124124
[
@@ -127,7 +127,7 @@ let rec fib = function | 0 | 1 -> 1 | n -> (fib (n - 1)) + (fib (n - 2))
127127
expression
128128
Texp_apply
129129
apply_mode Default
130-
alloc_mode <modevar>
130+
alloc_mode global
131131
expression
132132
Texp_ident "Stdlib!.-"
133133
[
@@ -146,7 +146,7 @@ let rec fib = function | 0 | 1 -> 1 | n -> (fib (n - 1)) + (fib (n - 2))
146146
expression
147147
Texp_apply
148148
apply_mode Default
149-
alloc_mode <modevar>
149+
alloc_mode global
150150
expression
151151
Texp_ident "fib"
152152
[
@@ -155,7 +155,7 @@ let rec fib = function | 0 | 1 -> 1 | n -> (fib (n - 1)) + (fib (n - 2))
155155
expression
156156
Texp_apply
157157
apply_mode Default
158-
alloc_mode <modevar>
158+
alloc_mode global
159159
expression
160160
Texp_ident "Stdlib!.-"
161161
[

‎testsuite/tests/typing-local/local.ml

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -760,10 +760,10 @@ let baduse (f : _ -> _ -> _) x y = lazy (f x y)
760760
let result = baduse (fun a b -> local_ (a,b)) 1 2
761761
[%%expect{|
762762
val baduse : ('a -> 'b -> 'c) -> 'a -> 'b -> 'c lazy_t = <fun>
763-
Line 2, characters 32-44:
763+
Line 2, characters 20-45:
764764
2 | let result = baduse (fun a b -> local_ (a,b)) 1 2
765-
^^^^^^^^^^^^
766-
Error: This value escapes its region
765+
^^^^^^^^^^^^^^^^^^^^^^^^^
766+
Error: This function is local returning, but was expected otherwise
767767
|}]
768768

769769

@@ -1403,10 +1403,10 @@ val foo : unit -> local_ string = <fun>
14031403
14041404
let foo : unit -> string = fun () -> local_ "hello"
14051405
[%%expect{|
1406-
Line 1, characters 37-51:
1406+
Line 1, characters 27-51:
14071407
1 | let foo : unit -> string = fun () -> local_ "hello"
1408-
^^^^^^^^^^^^^^
1409-
Error: This value escapes its region
1408+
^^^^^^^^^^^^^^^^^^^^^^^^
1409+
Error: This function is local returning, but was expected otherwise
14101410
|}]
14111411
14121412
(* Unboxed type constructors do not affect regionality *)

‎typing/env.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -315,7 +315,7 @@ type escaping_context =
315315
| Partial_application
316316

317317
type value_lock =
318-
| Lock of { mode : Value_mode.t; escaping_context : escaping_context option }
318+
| Lock of { mode : Alloc_mode.t; escaping_context : escaping_context option }
319319
| Region_lock
320320

321321
module IdTbl =
@@ -2852,7 +2852,7 @@ let lock_mode ~errors ~loc env id vmode locks =
28522852
match lock with
28532853
| Region_lock -> Value_mode.local_to_regional vmode
28542854
| Lock {mode; escaping_context} ->
2855-
match Value_mode.submode vmode mode with
2855+
match Value_mode.submode vmode (Value_mode.of_alloc mode) with
28562856
| Ok () -> vmode
28572857
| Error _ ->
28582858
may_lookup_error errors loc env

‎typing/env.mli

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -387,7 +387,7 @@ val enter_unbound_module : string -> module_unbound_reason -> t -> t
387387

388388
(* Lock the environment *)
389389

390-
val add_lock : ?escaping_context:escaping_context -> Types.value_mode -> t -> t
390+
val add_lock : ?escaping_context:escaping_context -> Types.alloc_mode -> t -> t
391391
val add_region_lock : t -> t
392392

393393
(* Initialize the cache of in-core module interfaces. *)

‎typing/typeclass.ml

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -967,8 +967,8 @@ and class_fields_second_pass cl_num sign met_env fields =
967967
and class_structure cl_num virt self_scope final val_env met_env loc
968968
{ pcstr_self = spat; pcstr_fields = str } =
969969
(* Environment for substructures *)
970-
let val_env = Env.add_lock Value_mode.global val_env in
971-
let met_env = Env.add_lock Value_mode.global met_env in
970+
let val_env = Env.add_lock Alloc_mode.global val_env in
971+
let met_env = Env.add_lock Alloc_mode.global met_env in
972972
let par_env = met_env in
973973

974974
(* Location of self. Used for locations of self arguments *)
@@ -1193,7 +1193,7 @@ and class_expr_aux cl_num val_env met_env virt self_scope scl =
11931193
Typecore.check_partial val_env pat.pat_type pat.pat_loc
11941194
[{c_lhs = pat; c_guard = None; c_rhs = dummy}]
11951195
in
1196-
let val_env' = Env.add_lock Value_mode.global val_env' in
1196+
let val_env' = Env.add_lock Alloc_mode.global val_env' in
11971197
Ctype.raise_nongen_level ();
11981198
let cl = class_expr cl_num val_env' met_env virt self_scope scl' in
11991199
Ctype.end_def ();

0 commit comments

Comments
 (0)