Skip to content

Commit

Permalink
Do not sort and de-dupe the nested KMap/KSet, only the result
Browse files Browse the repository at this point in the history
  • Loading branch information
@geo2a
geo2a committed Apr 4, 2024
1 parent 4803840 commit 500715b
Show file tree
Hide file tree
Showing 2 changed files with 33 additions and 39 deletions.
16 changes: 8 additions & 8 deletions library/Booster/Pattern/Base.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -591,7 +591,7 @@ pattern KMap def keyVals rest <- Term _ (KMapF def keyVals rest)
(_ : _, Just r) ->
foldl' (<>) (getAttributes r) $ concatMap (\(k, v) -> [getAttributes k, getAttributes v]) keyVals
(keyVals', rest') = case rest of
Just (KMap def' kvs r) | def' == def -> (sortAndDeduplicate kvs, r)
Just (KMap def' kvs r) | def' == def -> (kvs, r)
r -> ([], r)
newKeyVals = sortAndDeduplicate $ keyVals ++ keyVals'
newRest = rest'
Expand Down Expand Up @@ -654,13 +654,13 @@ pattern KSet def elements rest <- Term _ (KSetF def elements rest)
foldl1' (<>) $ map getAttributes elements
| Just r <- rest =
foldl' (<>) (getAttributes r) . map getAttributes $ elements
(newElements, newRest) = case rest of
Just (KSet def' elements' rest')
| def /= def' ->
error $ "Inconsistent set definition " <> show (def, def')
| otherwise ->
(sortAndDeduplicate $ elements <> elements', rest')
other -> (sortAndDeduplicate elements, other)
(elements', rest') = case rest of
Just (KSet def' es r)
| def /= def' -> error $ "Inconsistent set definition " <> show (def, def')
| otherwise -> (es, r)
other -> ([], other)
newElements = sortAndDeduplicate $ elements <> elements'
newRest = rest'
in Term
argAttributes
{ hash =
Expand Down
56 changes: 25 additions & 31 deletions unit-tests/Test/Booster/Pattern/InternalCollections.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -187,26 +187,22 @@ setSmartConstructors :: TestTree
setSmartConstructors =
testGroup
"pattern KSet"
[ testCase "Fully concrete KSet" $
let input = makeKSetNoRest [3, 1, 2]
expected = makeKSetNoRest [1, 2, 3]
in input @=? expected
, testCase "Fully concrete KSet, with duplicates" $
let input = makeKSetNoRest [3, 1, 2, 2, 3, 1]
expected = makeKSetNoRest [1, 2, 3]
in input @=? expected
, testCase "Concrete KSet with nested concrete KSet" $
let input = makeKSetWithRest [3, 1, 2] (makeKSetNoRest [6, 4, 5])
[ testCase "Concrete KSet with nested concrete KSet" $
let input = makeKSetWithRest [1, 2, 3] (makeKSetNoRest [4, 5, 6])
expected = makeKSetNoRest [1, 2, 3, 4, 5, 6]
in input @=? expected
, testCase "KSet with a symbolic rest" $
let input = makeKSetWithRest [3, 1, 2] [trm| REST:SortTestSet{}|]
expected = makeKSetWithRest [1, 2, 3] [trm| REST:SortTestSet{}|]
in input @=? expected
in expected @=? input
, testCase "Concrete KSet with nested concrete KSet (results needs sorting and de-duping)" $
let input = makeKSetWithRest [1, 2, 3] (makeKSetNoRest [1, 2, 4])
expected = makeKSetNoRest [1, 2, 3, 4]
in expected @=? input
, testCase "KSet with a nested KSet with a symbolic rest" $
let input = makeKSetWithRest [3, 1, 2] (makeKSetWithRest [6, 4, 5] [trm| REST:SortTestSet{}|])
let input = makeKSetWithRest [1, 2, 3] (makeKSetWithRest [4, 5, 6] [trm| REST:SortTestSet{}|])
expected = makeKSetWithRest [1, 2, 3, 4, 5, 6] [trm| REST:SortTestSet{}|]
in input @=? expected
in expected @=? input
, testCase "KSet with a nested KSet with a symbolic rest (results needs sorting and de-duping)" $
let input = makeKSetWithRest [1, 2, 3] (makeKSetWithRest [1, 2, 4] [trm| REST:SortTestSet{}|])
expected = makeKSetWithRest [1, 2, 3, 4] [trm| REST:SortTestSet{}|]
in expected @=? input
]
where
makeKSetNoRest :: [Int] -> Term
Expand Down Expand Up @@ -258,35 +254,33 @@ mapSmartConstructors :: TestTree
mapSmartConstructors =
testGroup
"pattern KMap"
[ testCase "Fully concrete KMap" $
let input = makeKMapNoRest [3, 1, 2]
expected = makeKMapNoRest [1, 2, 3]
in input @=? expected
, testCase "Fully concrete KMap, with duplicates" $
let input = makeKMapNoRest [3, 1, 2, 2, 3, 1]
expected = makeKMapNoRest [1, 2, 3]
in input @=? expected
, testCase "Concrete KMap with nested concrete KMap" $
let input = makeKMapWithRest [3, 1, 2] (makeKMapNoRest [6, 4, 5])
[ testCase "Concrete KMap with nested concrete KMap" $
let input = makeKMapWithRest [1, 2, 3] (makeKMapNoRest [4, 5, 6])
expected = makeKMapNoRest [1, 2, 3, 4, 5, 6]
in input @=? expected
, testCase "KMap with a symbolic rest" $
let input = makeKMapWithRest [3, 1, 2] [trm| REST:SortTestMap{}|]
expected = makeKMapWithRest [1, 2, 3] [trm| REST:SortTestMap{}|]
, testCase "Concrete KMap with nested concrete KMap (results needs sorting and de-duping)" $
let input = makeKMapWithRest [1, 2, 3] (makeKMapNoRest [1, 2, 4])
expected = makeKMapNoRest [1, 2, 3, 4]
in input @=? expected
, testCase "KMap with a nested KMap with a symbolic rest" $
let input = makeKMapWithRest [3, 1, 2] (makeKMapWithRest [6, 4, 5] [trm| REST:SortTestMap{}|])
let input = makeKMapWithRest [1, 2, 3] (makeKMapWithRest [4, 5, 6] [trm| REST:SortTestMap{}|])
expected = makeKMapWithRest [1, 2, 3, 4, 5, 6] [trm| REST:SortTestMap{}|]
in input @=? expected
, testCase "KMap with a nested KMap with a symbolic rest (results needs sorting and de-duping)" $
let input = makeKMapWithRest [1, 2, 3] (makeKMapWithRest [1, 2, 4] [trm| REST:SortTestMap{}|])
expected = makeKMapWithRest [1, 2, 3, 4] [trm| REST:SortTestMap{}|]
in input @=? expected
]
where
-- produced a map of identities for all input ints: x1 |-> x1, x2 |-> x2 ...
makeKMapNoRest :: [Int] -> Term
makeKMapNoRest xs =
KMap
Fixture.testKMapDefinition
(zip (makeDVs xs) (makeDVs xs))
Nothing

-- produced a map of identities for all input ints and an opaque rest: x1 |-> x1, x2 |-> x2 ..., REST
makeKMapWithRest :: [Int] -> Term -> Term
makeKMapWithRest xs rest =
KMap
Expand Down

0 comments on commit 500715b

Please sign in to comment.