diff --git a/booster/library/Booster/Builtin/MAP.hs b/booster/library/Booster/Builtin/MAP.hs index 5bbec86a11..7a2465ec6f 100644 --- a/booster/library/Booster/Builtin/MAP.hs +++ b/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 diff --git a/booster/unit-tests/Test/Booster/Builtin.hs b/booster/unit-tests/Test/Booster/Builtin.hs index d06979524e..8ebc4d1082 100644 --- a/booster/unit-tests/Test/Booster/Builtin.hs +++ b/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)