@@ -454,7 +454,7 @@ shapeToTerm' sc = go
454
454
ty <- go sub shp
455
455
liftIO (mkVec n ty)
456
456
go (AdaptDerefSlice col n ada) (SliceShape _ elT M. Immut tpr) =
457
- do et <- go ada (tyToShapeEq col elT tpr)
457
+ do et <- go ada (tyToShapeEq col elT tpr)
458
458
liftIO (mkVec n et)
459
459
go _ada shp = fail $ " shapeToTerm: unsupported type " ++ show (shapeType shp)
460
460
@@ -568,6 +568,7 @@ buildMirAggregate sym elems xs f = do
568
568
-- offset, size, type, and value of the entry, and its result is stored as the
569
569
-- new value in the output.
570
570
traverseMirAggregate ::
571
+ forall sym m .
571
572
(IsSymInterface sym , Monad m , MonadFail m , MonadIO m ) =>
572
573
sym ->
573
574
[AgElemShape ] ->
@@ -576,7 +577,35 @@ traverseMirAggregate ::
576
577
m (MirAggregate sym )
577
578
traverseMirAggregate sym elems (MirAggregate totalSize m) f = do
578
579
agCheckKeysEq " traverseMirAggregate" elems m
579
- m' <- sequence $ IntMap. mergeWithKey
580
+ m' <-
581
+ -- Hack: we include a special case for when the list of AgElemShapes and
582
+ -- the MirAggregate are both empty, skipping the call to mergeEntries
583
+ -- entirely if this is the case. This is because mergeEntries calls
584
+ -- IntMap.mergeWithKey under the hood, and prior to containers-0.8, the
585
+ -- implementation of IntMap.mergeWithKey had a bug where merging two empty
586
+ -- IntMaps would invoke the third callback argument instead of just
587
+ -- returning an empty map. (See
588
+ -- https://github.com/haskell/containers/issues/979.) Note that
589
+ -- mergeEntries uses the third callback argument to panic, however, and we
590
+ -- definitely don't want to panic if the IntMaps are both empty!
591
+ --
592
+ -- Because SAW still supports GHC versions that bundle versions of
593
+ -- containers that are older than 0.8 (and therefore do not contain a fix
594
+ -- for the issue above), we include this special case as a workaround. Once
595
+ -- SAW drops support for pre-0.8 versions of containers, we can remove this
596
+ -- special case.
597
+ if null elems && IntMap. null m
598
+ then pure IntMap. empty
599
+ else mergeEntries
600
+ return $ MirAggregate totalSize m'
601
+ where
602
+ -- Merge the existing MirAggregate's entries together with the new entries
603
+ -- from the list of AgElemShapes.
604
+ --
605
+ -- Precondition: both the list of AgElemShapes and the MirAggregate are
606
+ -- non-empty (see the comments above near mergeEntries' call site).
607
+ mergeEntries :: m (IntMap (MirAggregateEntry sym ))
608
+ mergeEntries = sequence $ IntMap. mergeWithKey
580
609
(\ _off' (AgElemShape off _sz' shp) (MirAggregateEntry sz tpr rvPart) -> Just $ do
581
610
Refl <- case testEquality tpr (shapeType shp) of
582
611
Just pf -> return pf
@@ -590,7 +619,6 @@ traverseMirAggregate sym elems (MirAggregate totalSize m) f = do
590
619
(\ _ -> panic " traverseMirAggregate" [" mismatched keys in aggregate" ])
591
620
(IntMap. fromList [(fromIntegral off, e) | e@ (AgElemShape off _ _) <- elems])
592
621
m
593
- return $ MirAggregate totalSize m'
594
622
595
623
-- | Extract values from a `MirAggregate`, one for each entry. The callback
596
624
-- gets the offset, size, type, and value of the entry. Callback results are
0 commit comments