mirror of
https://github.com/unisonweb/unison.git
synced 2024-10-03 21:28:01 +03:00
Make Combs a small enum map
This commit is contained in:
parent
6e88909eb8
commit
6c74fe3620
@ -33,6 +33,7 @@ module Unison.Util.EnumContainers
|
||||
smallEnumMapElems,
|
||||
smallEnumMapToList,
|
||||
smallEnumMapLookup,
|
||||
smallEnumMapMapWithKey,
|
||||
)
|
||||
where
|
||||
|
||||
@ -187,6 +188,17 @@ data SmallEnumMap v
|
||||
{-# UNPACK #-} !(Vector.Vector v) -- values
|
||||
deriving (Show, Eq, Ord, Functor, Foldable, Traversable)
|
||||
|
||||
-- | Note: this is inefficient, but SmallEnumMaps aren't meant to have efficient updates.
|
||||
instance Semigroup (SmallEnumMap v) where
|
||||
m1 <> m2 = smallEnumMapFromList (smallEnumMapToList m1 <> smallEnumMapToList m2)
|
||||
|
||||
instance Monoid (SmallEnumMap v) where
|
||||
mempty = SmallEnumMap mempty mempty
|
||||
|
||||
smallEnumMapMapWithKey :: (Word64 -> v -> v') -> SmallEnumMap v -> SmallEnumMap v'
|
||||
smallEnumMapMapWithKey f (SmallEnumMap keys values) =
|
||||
SmallEnumMap keys (Vector.imap (\i v -> f (VUnboxed.unsafeIndex keys i) v) values)
|
||||
|
||||
mapToSmallEnumMap :: EnumMap Word64 v -> SmallEnumMap v
|
||||
mapToSmallEnumMap !(EM m) =
|
||||
let (keys, values) = unzip $ IM.toList m
|
||||
|
@ -1205,7 +1205,7 @@ data StoredCache
|
||||
|
||||
putStoredCache :: (MonadPut m) => StoredCache -> m ()
|
||||
putStoredCache (SCache cs crs trs ftm fty int rtm rty sbs) = do
|
||||
putEnumMap putNat (putEnumMap putNat putComb) cs
|
||||
putEnumMap putNat (putSmallEnumMap putNat putComb) cs
|
||||
putEnumMap putNat putReference crs
|
||||
putEnumMap putNat putReference trs
|
||||
putNat ftm
|
||||
@ -1218,7 +1218,7 @@ putStoredCache (SCache cs crs trs ftm fty int rtm rty sbs) = do
|
||||
getStoredCache :: (MonadGet m) => m StoredCache
|
||||
getStoredCache =
|
||||
SCache
|
||||
<$> getEnumMap getNat (getEnumMap getNat getComb)
|
||||
<$> getEnumMap getNat (getSmallEnumMap getNat getComb)
|
||||
<*> getEnumMap getNat getReference
|
||||
<*> getEnumMap getNat getReference
|
||||
<*> getNat
|
||||
@ -1275,7 +1275,7 @@ restoreCache (SCache cs crs trs ftm fty int rtm rty sbs) =
|
||||
rf k = builtinTermBackref ! k
|
||||
combs =
|
||||
mapWithKey
|
||||
(\k v -> emitComb @Symbol rns (rf k) k mempty (0, v))
|
||||
(\k v -> mapToSmallEnumMap $ emitComb @Symbol rns (rf k) k mempty (0, v))
|
||||
numberedTermLookup
|
||||
|
||||
traceNeeded ::
|
||||
|
@ -592,7 +592,7 @@ data Comb
|
||||
!Section -- Entry
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
type Combs = EnumMap Word64 Comb
|
||||
type Combs = SmallEnumMap Comb
|
||||
|
||||
data Ref
|
||||
= Stk !Int -- stack reference to a closure
|
||||
|
@ -120,7 +120,7 @@ refNumTy' cc r = M.lookup r <$> refNumsTy cc
|
||||
baseCCache :: Bool -> IO CCache
|
||||
baseCCache sandboxed = do
|
||||
CCache ffuncs sandboxed noTrace
|
||||
<$> newTVarIO combs
|
||||
<$> newTVarIO (mapToSmallEnumMap <$> combs)
|
||||
<*> newTVarIO builtinTermBackref
|
||||
<*> newTVarIO builtinTypeBackref
|
||||
<*> newTVarIO ftm
|
||||
@ -1925,7 +1925,7 @@ unhandledErr fname env i =
|
||||
combSection :: (HasCallStack) => CCache -> CombIx -> IO Comb
|
||||
combSection env (CIx _ n i) =
|
||||
readTVarIO (combs env) >>= \cs -> case EC.lookup n cs of
|
||||
Just cmbs -> case EC.lookup i cmbs of
|
||||
Just cmbs -> case EC.smallEnumMapLookup i cmbs of
|
||||
Just cmb -> pure cmb
|
||||
Nothing ->
|
||||
die $
|
||||
@ -2098,7 +2098,7 @@ cacheAdd0 ntys0 tml sands cc = atomically $ do
|
||||
rtm <- updateMap (M.fromList $ zip rs [ntm ..]) (refTm cc)
|
||||
-- check for missing references
|
||||
let rns = RN (refLookup "ty" rty) (refLookup "tm" rtm)
|
||||
combinate n (r, g) = (n, emitCombs rns r n g)
|
||||
combinate n (r, g) = (n, mapToSmallEnumMap $ emitCombs rns r n g)
|
||||
nrs <- updateMap (mapFromList $ zip [ntm ..] rs) (combRefs cc)
|
||||
ncs <- updateMap (mapFromList $ zipWith combinate [ntm ..] rgs) (combs cc)
|
||||
nsn <- updateMap (M.fromList sands) (sandbox cc)
|
||||
|
Loading…
Reference in New Issue
Block a user