add cases for unevaluated keys to MAP hooks (#3964)

Some of the `MAP` hooks were missing cases for an unevaluated key
argument (they were assuming that the argument would already be fully
evaluated when the hook is called).
In these cases, the hooks should typically return `Nothing` instead of
returning a result.

---------

Co-authored-by: github-actions <[email protected]>

Author: jberthold

booster/library/Booster/Builtin/MAP.hs

@@ -58,6 +58,8 @@ mapUpdateHook args
                     pure Nothing -- have opaque part, no result
                 | any (not . isConstructorLike_ . fst) pairs ->
                     pure Nothing -- have unevaluated keys, no result
+                | not $ isConstructorLike_ key ->
+                    pure Nothing -- unevaluated update key, no result
                 | otherwise -> -- key certain to be absent, no rest: add pair
                     pure $ Just $ KMap def ((key, newValue) : pairs) Nothing
     | [_other, _, _] <- args =
@@ -126,6 +128,8 @@ mapRemoveHook args
                     pure Nothing -- have opaque part, no result
                 | any (not . isConstructorLike_ . fst) pairs ->
                     pure Nothing -- have unevaluated keys, no result
+                | not $ isConstructorLike_ key ->
+                    pure Nothing -- remove key unevaluated, no result
                 | otherwise -> -- key certain to be absent, no rest: map unchanged
                     pure $ Just m
     | [_other, _] <- args =
@@ -166,6 +170,8 @@ mapLookupOrDefaultHook args
                     pure Nothing -- have opaque part, no result
                 | any (not . isConstructorLike_ . fst) pairs ->
                     pure Nothing -- have unevaluated keys, no result
+                | not $ isConstructorLike_ key ->
+                    pure Nothing -- lookup key unevaluated, no result
                 | otherwise -> -- certain that the key is not in the map
                     pure $ Just defaultValue
     | [_other, _, _] <- args =
@@ -188,6 +194,7 @@ mapInKeysHook args
                 pure $ Just $ boolTerm True
             (False, False)
                 | Nothing <- mbRest -- no opaque rest
+                , isConstructorLike_ key -- key to search is evaluated
                 , null uneval'edKeys -> -- no keys unevaluated
                     pure $ Just $ boolTerm False
                 | otherwise -> -- key could be present once evaluated

booster/unit-tests/Test/Booster/Builtin.hs

@@ -260,6 +260,10 @@ testMapUpdateHook =
             result <- runUpdate [Fixture.functionKMapWithOneItemAndRest, keyG, value2]
             let expected = mapWith [(keyG, value2)] (Just restVar)
             Just expected @=? result
+        , testCase "cannot update map at unevaluated key if key not syntactically present" $ do
+            let keyG = [trm| g{}() |]
+            result <- runUpdate [Fixture.concreteKMapWithTwoItems, keyG, value2]
+            Nothing @=? result
         , testCase "cannot update map with symbolic rest if key not present" $ do
             result <- runUpdate [Fixture.concreteKMapWithOneItemAndRest, key2, value2]
             Nothing @=? result
@@ -376,6 +380,9 @@ testMapRemoveHook =
             Just Fixture.emptyKMap @=? result
             result2 <- runRemove [Fixture.functionKMapWithOneItemAndRest, [trm| g{}() |]]
             Just restVar @=? result2
+        , testCase "no result if removing non-concrete keys not syntactically equal" $ do
+            result <- runRemove [Fixture.concreteKMapWithTwoItems, [trm| g{}() |]]
+            Nothing @=? result
         , testCase "no result when map has non-concrete syntactically different keys" $ do
             result <- runRemove [Fixture.functionKMapWithOneItem, key]
             Nothing @=? result
@@ -449,6 +456,10 @@ testMapLookupHook =
         , testCase "returns item for a non-evaluated key when present" $ do
             result <- runLookup [Fixture.functionKMapWithOneItemAndRest, [trm| g{}() |]]
             Just [trm| \dv{SortTestKMapItem{}}("value") |] @=? result
+        , testProperty "no result for an unevaluated key not syntactically present" . property $ do
+            assocs <- forAll $ genAssocs (Range.linear 0 10)
+            result <- runLookup [mapWith assocs Nothing, [trm| g{}() |]]
+            Nothing === result
         , testCase "no result if map has non-evaluated keys when key not found" $ do
             result <- runLookup [Fixture.functionKMapWithOneItem, notAKey]
             Nothing @=? result
@@ -494,6 +505,10 @@ testMapLookupOrDefaultHook =
         , testCase "returns item for a non-evaluated key when present" $ do
             result <- runLookup [Fixture.functionKMapWithOneItemAndRest, [trm| g{}() |], defItem]
             Just [trm| \dv{SortTestKMapItem{}}("value") |] @=? result
+        , testProperty "no result for an unevaluated key not syntactically present" . property $ do
+            assocs <- forAll $ genAssocs (Range.linear 0 10)
+            result <- runLookup [mapWith assocs Nothing, [trm| g{}() |], defItem]
+            Nothing === result
         , testCase "no result if map has non-evaluated keys and key not found" $ do
             result <- runLookup [Fixture.functionKMapWithOneItemAndRest, notAKey, defItem]
             Nothing @=? result
@@ -532,11 +547,20 @@ testMapInKeysHook =
             Just (Builtin.boolTerm True) === result
             result2 <- runInKeys [key, mapWith assocs (Just restVar)]
             Just (Builtin.boolTerm True) === result2
+        , testCase "returns true when key syntactically present" $ do
+            result <- runInKeys [[trm| g{}() |], Fixture.functionKMapWithOneItem]
+            Just (Builtin.boolTerm True) @=? result
+            result2 <- runInKeys [[trm| g{}() |], Fixture.functionKMapWithOneItemAndRest]
+            Just (Builtin.boolTerm True) @=? result2
         , testCase "no result if unevaluated map keys present" $ do
             result <- runInKeys [notAKey, Fixture.functionKMapWithOneItem]
             Nothing @=? result
             result2 <- runInKeys [notAKey, Fixture.functionKMapWithOneItemAndRest]
             Nothing @=? result2
+        , testProperty "no result for an unevaluated key not present" . property $ do
+            assocs <- forAll $ genAssocs (Range.linear 0 42)
+            result <- runInKeys [[trm| g{}() |], mapWith assocs Nothing]
+            Nothing === result
         ]
   where
     runInKeys :: MonadFail m => [Term] -> m (Maybe Term)