unisonweb/unison
1
0
Fork 0
mirror of https://github.com/unisonweb/unison.git synced 2024-10-03 21:28:01 +03:00
Code Issues Projects Releases Wiki Activity

Make Combs a small enum map

Browse Source
This commit is contained in:
Chris Penner 2024-08-30 17:06:43 -07:00
parent 6e88909eb8
commit 6c74fe3620
4 changed files with 19 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
parser-typechecker/src/Unison/Util/EnumContainers.hs
View File

@ -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

6
unison-runtime/src/Unison/Runtime/Interface.hs
View File

@ -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 ::

2
unison-runtime/src/Unison/Runtime/MCode.hs
View File

@ -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

6
unison-runtime/src/Unison/Runtime/Machine.hs
View File

@ -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)