[erl-frontend] Add support for OTP 28 strict map generator

Summary: Add support for the <:- strict generator which fails if any RHS element doesn't match the LHS pattern, see https://www.erlang.org/eeps/eep-0070.

Reviewed By: rgrig

Differential Revision: D91221323

fbshipit-source-id: 06a65ce779f6e386b1c45509f12135092f572ee2

Author: hajduakos

infer/src/erlang/ErlangAst.ml

@@ -114,7 +114,7 @@ and qualifier =
   | BitsGenerator of {pattern: expression; expression: expression}
   | Filter of expression
   | Generator of {pattern: expression; expression: expression; strict: bool}
-  | MapGenerator of {pattern: association; expression: expression}
+  | MapGenerator of {pattern: association; expression: expression; strict: bool}
 
 and timeout = {time: expression; handler: body}
 

infer/src/erlang/ErlangJsonParser.ml

@@ -520,7 +520,11 @@ and to_qualifier gen_uniq json : Ast.qualifier option =
   | `List [`String "m_generate"; _anno; pattern; expression] ->
       let* pattern = to_association gen_uniq pattern in
       let* expression = to_expression gen_uniq expression in
-      Some (Ast.MapGenerator {pattern; expression})
+      Some (Ast.MapGenerator {pattern; expression; strict= false})
+  | `List [`String "m_generate_strict"; _anno; pattern; expression] ->
+      let* pattern = to_association gen_uniq pattern in
+      let* expression = to_expression gen_uniq expression in
+      Some (Ast.MapGenerator {pattern; expression; strict= true})
   | filter ->
       let* filter = to_expression gen_uniq filter in
       Some (Ast.Filter filter)

infer/src/erlang/ErlangTranslator.ml

@@ -1042,7 +1042,7 @@ and translate_comprehension_loop (env : (_, _) Env.t) loop_body qualifiers : Blo
         let init_block = Block.all env [init_block; check_block] in
         let mk_matcher head_var = translate_pattern env head_var pattern in
         make_gen gen_var init_block mk_matcher strict
-    | MapGenerator {pattern; expression} ->
+    | MapGenerator {pattern; expression; strict} ->
         let gen_var = mk_fresh_id () in
         let init_block =
           (* Turn the generator map into a list of {key, val} pairs *)
@@ -1070,7 +1070,7 @@ and translate_comprehension_loop (env : (_, _) Env.t) loop_body qualifiers : Blo
           key_val_load |~~> [matcher.start] ;
           {matcher with start= key_val_load}
         in
-        make_gen gen_var init_block mk_matcher false (* Strict mode not yet parsed for maps *)
+        make_gen gen_var init_block mk_matcher strict
     | BitsGenerator _ ->
         let unsupported = call_unsupported "bits_generator" 0 in
         let call_instr = builtin_call env (mk_fresh_id ()) unsupported [] in

infer/tests/codetoanalyze/erlang/compiler/issues.exp

@@ -453,6 +453,10 @@ features_mc:test_mapgen_empty_Bad/0: expected_crash
 features_mc:test_mapgen_empty_Ok/0: ok
 features_mc:test_mapgen_nonempty_Bad/0: expected_crash
 features_mc:test_mapgen_nonempty_Ok/0: ok
+features_mc:test_mapgen_nonstrict_Bad/0: expected_crash
+features_mc:test_mapgen_nonstrict_Ok/0: ok
+features_mc:test_mapgen_strict_Bad/0: badmatch
+features_mc:test_mapgen_strict_Ok/0: ok
 
 ----- features_receive -----
 features_receive:test_receive1_Ok/0: ok

infer/tests/codetoanalyze/erlang/pulse/features/features_mc.erl

@@ -20,7 +20,11 @@
     test_mapgen_badmap_Bad/0,
     test_mapgen_badmap2_Bad/0,
     test_mapcomp_with_mapgen_Ok/0,
-    test_mapcomp_with_mapgen_Bad/0
+    test_mapcomp_with_mapgen_Bad/0,
+    test_mapgen_nonstrict_Ok/0,
+    test_mapgen_nonstrict_Bad/0,
+    test_mapgen_strict_Ok/0,
+    test_mapgen_strict_Bad/0
 ]).
 
 test_mapcomp_Ok() ->
@@ -91,3 +95,22 @@ test_mapcomp_with_mapgen_Bad() ->
     M = #{1 => 2},
     M2 = #{V => K || K := V <- M},
     ?CRASH_IF_EQUAL(1, maps:get(2, M2)).
+
+test_mapgen_nonstrict_Ok() ->
+    M = #{1 => 2},
+    L = [K || K := 2 <- M],
+    ?ASSERT_EQUAL([1], L).
+
+test_mapgen_nonstrict_Bad() ->
+    M = #{1 => 2},
+    L = [K || K := 2 <- M],
+    ?CRASH_IF_EQUAL([1], L).
+
+test_mapgen_strict_Ok() ->
+    M = #{1 => 2},
+    L = [K || K := 2 <:- M],
+    ?ASSERT_EQUAL([1], L).
+
+test_mapgen_strict_Bad() ->
+    M = #{1 => 2},
+    L = [K || K := 3 <:- M].

infer/tests/codetoanalyze/erlang/pulse/issues.exp

@@ -237,6 +237,8 @@ codetoanalyze/erlang/pulse/features/features_mc.erl, fp_test_mapgen_nonempty2_Ok
 codetoanalyze/erlang/pulse/features/features_mc.erl, test_mapgen_badmap_Bad/0, 2, BAD_GENERATOR, no_bucket, ERROR, [bad generator here]
 codetoanalyze/erlang/pulse/features/features_mc.erl, test_mapgen_badmap2_Bad/0, 2, BAD_GENERATOR, no_bucket, ERROR, [bad generator here]
 codetoanalyze/erlang/pulse/features/features_mc.erl, test_mapcomp_with_mapgen_Bad/0, 3, NO_MATCH_OF_RHS, no_bucket, ERROR, [no match of RHS here]
+codetoanalyze/erlang/pulse/features/features_mc.erl, test_mapgen_nonstrict_Bad/0, 3, NO_MATCH_OF_RHS, no_bucket, ERROR, [no match of RHS here]
+codetoanalyze/erlang/pulse/features/features_mc.erl, test_mapgen_strict_Bad/0, 2, NO_MATCH_OF_RHS, no_bucket, ERROR, [no match of RHS here]
 codetoanalyze/erlang/pulse/features/features_receive.erl, test_receive2_Bad/0, 7, NO_MATCH_OF_RHS, no_bucket, ERROR, [no match of RHS here]
 codetoanalyze/erlang/pulse/features/features_receive.erl, test_receive4_Bad/0, 6, NO_MATCH_OF_RHS, no_bucket, ERROR, [no match of RHS here]
 codetoanalyze/erlang/pulse/features/features_receive.erl, test_receive5_Bad/0, 6, NO_MATCH_OF_RHS, no_bucket, ERROR, [no match of RHS here]