Skip to content

Commit f5823a9

Browse files
authored
Fix LIST.in hook for non-constructor-like list elements (#4111)
The previous list hook implementation `LIST.in` was testing membership based on _syntactic_ equality. This is incorrect if the elements of the list are not constructor-like (like variables or unevaluated function calls), `False` cannot be returned in those cases. When all known list elements are constructor-like, syntactic equality is sufficient. A unit test was added for this case.
1 parent b6a5b43 commit f5823a9

File tree

4 files changed

+41
-5
lines changed

4 files changed

+41
-5
lines changed

booster/library/Booster/Builtin/LIST.hs

Lines changed: 11 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,5 @@
1+
{-# LANGUAGE PatternSynonyms #-}
2+
13
{- |
24
Copyright : (c) Runtime Verification, 2023
35
License : BSD-3-Clause
@@ -17,14 +19,14 @@ import Data.ByteString.Char8 (ByteString, pack)
1719
import Data.Map (Map)
1820
import Data.Map qualified as Map
1921

20-
import Booster.Builtin.BOOL (boolTerm)
2122
import Booster.Builtin.Base
2223
import Booster.Builtin.INT
2324
import Booster.Definition.Attributes.Base (
2425
KCollectionSymbolNames (..),
2526
KListDefinition (..),
2627
)
2728
import Booster.Pattern.Base
29+
import Booster.Pattern.Bool (pattern FalseBool, pattern TrueBool)
2830

2931
builtinsLIST :: Map ByteString BuiltinFunction
3032
builtinsLIST =
@@ -109,11 +111,16 @@ listGetHook args =
109111
listInHook :: BuiltinFunction
110112
listInHook [e, KList _ heads rest] =
111113
case rest of
112-
Nothing -> pure $ Just $ boolTerm (e `elem` heads)
114+
Nothing
115+
| e `elem` heads -> pure $ Just TrueBool
116+
| e `notElem` heads
117+
, all isConstructorLike_ (e : heads) ->
118+
pure $ Just FalseBool
119+
| otherwise -> pure Nothing
113120
Just (_mid, tails)
114121
| e `elem` tails ->
115-
pure $ Just $ boolTerm True
116-
| otherwise -> -- could be in opaque _mid
122+
pure $ Just TrueBool
123+
| otherwise -> -- could be in opaque _mid or not constructor-like
117124
pure Nothing
118125
listInHook args =
119126
arityError "LIST.in" 2 args

booster/library/Booster/Pattern/Base.hs

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -125,6 +125,9 @@ data TermAttributes = TermAttributes
125125
-- variables, recursive through AndTerm
126126
, hash :: !Int
127127
, isConstructorLike :: !Bool
128+
-- ^ Means that logic equality is the same as syntactic equality.
129+
-- True for domain values and constructor symbols (recursive
130+
-- through arg.s), recursive through AndTerm.
128131
, canBeEvaluated :: !Bool
129132
-- ^ false for function calls, variables, and AndTerms
130133
}

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

Lines changed: 21 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -139,6 +139,15 @@ listOfThings n =
139139
let things = map numDV [1 .. n]
140140
in KList Fixture.testKListDef things Nothing
141141

142+
listWithVar :: Int -> Int -> Term
143+
listWithVar n place =
144+
case listOfThings n of
145+
KList def elems rest ->
146+
let variable = [trm| ELEM:SomeSort |]
147+
(front, back) = splitAt (max n place) elems
148+
in KList def (front <> [variable] <> back) rest
149+
_ -> error "unexpected term returned by listOfThings"
150+
142151
-- wrap an Int into an injection to KItem here
143152
numDV :: Int -> Term
144153
numDV n =
@@ -158,7 +167,8 @@ testListConcatHook =
158167
Just empty @=? result
159168
, testProperty "LIST.concat with an empty list argument" . property $ do
160169
l <- forAll smallNat
161-
let aList = listOfThings l
170+
v <- forAll smallNat
171+
let aList = listWithVar l v
162172
empty = listOfThings 0
163173
resultR <- evalHook "LIST.concat" [aList, empty]
164174
Just aList === resultR
@@ -242,6 +252,16 @@ testListInHook =
242252
target = numDV 0
243253
result <- evalHook "LIST.in" [target, list]
244254
result `shouldBe` False
255+
, testProperty
256+
"LIST.in is indeterminate when an item is not present in a list with a variable element"
257+
. property
258+
$ do
259+
l <- forAll smallNat
260+
v <- forAll smallNat
261+
let list = listWithVar l v -- [1 .. v-1, ELEM, v .. l]
262+
target = numDV 0
263+
result <- evalHook "LIST.in" [target, list]
264+
Nothing === result
245265
, testProperty "LIST.in is indeterminate when an item is not present (list with opaque middle)"
246266
. property
247267
$ do

package/version.sh

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -29,9 +29,15 @@ version_sub() {
2929
local version
3030
version="$(cat $version_file)"
3131
sed -i "s/^version: '.*'$/version: '${version}'/" dev-tools/package.yaml
32+
sed -i "s/^version: .*$/version: ${version}/" dev-tools/hs-backend-booster-dev-tools.cabal
33+
3234
sed -i "s/^version: '.*'$/version: '${version}'/" booster/package.yaml
35+
sed -i "s/^version: .*$/version: ${version}/" booster/hs-backend-booster.cabal
36+
3337
sed -i "s/^version: .*$/version: ${version}/" kore/kore.cabal
38+
3439
sed -i "s/^version: .*$/version: ${version}/" ./kore-rpc-types/kore-rpc-types.cabal
40+
3541
sed -i 's/^k-haskell-backend (.*) unstable; urgency=medium$/k-haskell-backend ('"$version"') unstable; urgency=medium/' package/debian/changelog
3642
}
3743

0 commit comments

Comments
 (0)