feat(pkg): simplify and/or_absorb_undefined_var

- Fixes #13669

Signed-off-by: Ali Caglayan <alizter@gmail.com>

Author: Alizter

src/dune_lang/slang.ml

@@ -334,21 +334,49 @@ let rec simplify = function
         | Form (_, Blang (Const _)) as value -> value
         | value -> Form (loc, Catch_undefined_var { value; fallback = simplify fallback }))
      | And_absorb_undefined_var blangs ->
-       let blangs : blang list =
+       let blangs =
          List.concat_map blangs ~f:(fun blang ->
            match simplify_blang blang with
            | Expr (Form (_, And_absorb_undefined_var blangs)) -> blangs
            | blang -> [ blang ])
        in
-       Form (loc, And_absorb_undefined_var blangs)
+       if
+         List.exists blangs ~f:(function
+           | Blang.Const false -> true
+           | _ -> false)
+       then Form (loc, Blang (Const false))
+       else (
+         let blangs =
+           List.filter blangs ~f:(function
+             | Blang.Const true -> false
+             | _ -> true)
+         in
+         match blangs with
+         | [] -> Form (loc, Blang (Const true))
+         | [ b ] -> Form (loc, Blang b)
+         | _ -> Form (loc, And_absorb_undefined_var blangs))
      | Or_absorb_undefined_var blangs ->
-       let blangs : blang list =
-         List.concat_map blangs ~f:(fun (blang : blang) ->
+       let blangs =
+         List.concat_map blangs ~f:(fun blang ->
            match simplify_blang blang with
            | Expr (Form (_, Or_absorb_undefined_var blangs)) -> blangs
            | blang -> [ blang ])
        in
-       Form (loc, Or_absorb_undefined_var (List.map blangs ~f:simplify_blang))
+       if
+         List.exists blangs ~f:(function
+           | Blang.Const true -> true
+           | _ -> false)
+       then Form (loc, Blang (Const true))
+       else (
+         let blangs =
+           List.filter blangs ~f:(function
+             | Blang.Const false -> false
+             | _ -> true)
+         in
+         match blangs with
+         | [] -> Form (loc, Blang (Const false))
+         | [ b ] -> Form (loc, Blang b)
+         | _ -> Form (loc, Or_absorb_undefined_var blangs))
      | Blang b -> Form (loc, Blang (simplify_blang b)))
 
 and simplify_blang = function

test/expect-tests/dune_lang/slang_tests.ml

@@ -360,45 +360,30 @@ let%expect_test "has_undefined_var const" =
 
 (* Slang: And_absorb_undefined_var *)
 
-(* CR-soon Alizter: and_absorb_undefined_var should simplify to [Blang (Const true)] *)
 let%expect_test "and_absorb empty" =
   print_slang (Slang.and_absorb_undefined_var []);
-  [%expect {| And_absorb_undefined_var |}]
+  [%expect {| Blang (Const true) |}]
 ;;
 
-(* CR-soon Alizter: and_absorb_undefined_var should unwrap singleton *)
 let%expect_test "and_absorb singleton" =
   print_slang (Slang.and_absorb_undefined_var [ expr (pform "x") ]);
-  [%expect {| And_absorb_undefined_var (Expr (Literal (template "%{pkg-self:x}"))) |}]
+  [%expect {| Blang (Expr (Literal (template "%{pkg-self:x}"))) |}]
 ;;
 
-(* CR-soon Alizter: and_absorb_undefined_var should filter true *)
 let%expect_test "and_absorb filters true" =
   print_slang (Slang.and_absorb_undefined_var [ const true; expr (pform "x") ]);
-  [%expect
-    {|
-    And_absorb_undefined_var
-      (Const true, Expr (Literal (template "%{pkg-self:x}")))
-    |}]
+  [%expect {| Blang (Expr (Literal (template "%{pkg-self:x}"))) |}]
 ;;
 
-(* CR-soon Alizter: and_absorb_undefined_var should short-circuit on false *)
 let%expect_test "and_absorb false short-circuits" =
   print_slang
     (Slang.and_absorb_undefined_var [ expr (pform "x"); const false; expr (pform "y") ]);
-  [%expect
-    {|
-    And_absorb_undefined_var
-      (Expr (Literal (template "%{pkg-self:x}")),
-       Const false,
-       Expr (Literal (template "%{pkg-self:y}")))
-    |}]
+  [%expect {| Blang (Const false) |}]
 ;;
 
-(* CR-soon Alizter: and_absorb_undefined_var should simplify to [Blang (Const true)] *)
 let%expect_test "and_absorb all true" =
   print_slang (Slang.and_absorb_undefined_var [ const true; const true ]);
-  [%expect {| And_absorb_undefined_var (Const true, Const true) |}]
+  [%expect {| Blang (Const true) |}]
 ;;
 
 let%expect_test "and_absorb flattens" =
@@ -418,45 +403,30 @@ let%expect_test "and_absorb flattens" =
 
 (* Slang: Or_absorb_undefined_var *)
 
-(* CR-soon Alizter: or_absorb_undefined_var should simplify to [Blang (Const false)] *)
 let%expect_test "or_absorb empty" =
   print_slang (Slang.or_absorb_undefined_var []);
-  [%expect {| Or_absorb_undefined_var |}]
+  [%expect {| Blang (Const false) |}]
 ;;
 
-(* CR-soon Alizter: or_absorb_undefined_var should unwrap singleton *)
 let%expect_test "or_absorb singleton" =
   print_slang (Slang.or_absorb_undefined_var [ expr (pform "x") ]);
-  [%expect {| Or_absorb_undefined_var (Expr (Literal (template "%{pkg-self:x}"))) |}]
+  [%expect {| Blang (Expr (Literal (template "%{pkg-self:x}"))) |}]
 ;;
 
-(* CR-soon Alizter: or_absorb_undefined_var should filter false *)
 let%expect_test "or_absorb filters false" =
   print_slang (Slang.or_absorb_undefined_var [ const false; expr (pform "x") ]);
-  [%expect
-    {|
-    Or_absorb_undefined_var
-      (Const false, Expr (Literal (template "%{pkg-self:x}")))
-    |}]
+  [%expect {| Blang (Expr (Literal (template "%{pkg-self:x}"))) |}]
 ;;
 
-(* CR-soon Alizter: or_absorb_undefined_var should short-circuit on true *)
 let%expect_test "or_absorb true short-circuits" =
   print_slang
     (Slang.or_absorb_undefined_var [ expr (pform "x"); const true; expr (pform "y") ]);
-  [%expect
-    {|
-    Or_absorb_undefined_var
-      (Expr (Literal (template "%{pkg-self:x}")),
-       Const true,
-       Expr (Literal (template "%{pkg-self:y}")))
-    |}]
+  [%expect {| Blang (Const true) |}]
 ;;
 
-(* CR-soon Alizter: or_absorb_undefined_var should simplify to [Blang (Const false)] *)
 let%expect_test "or_absorb all false" =
   print_slang (Slang.or_absorb_undefined_var [ const false; const false ]);
-  [%expect {| Or_absorb_undefined_var (Const false, Const false) |}]
+  [%expect {| Blang (Const false) |}]
 ;;
 
 let%expect_test "or_absorb flattens" =