{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- | Deterministic stripe assignment for separately checked units.
--
-- Each unit of a module system allocates its top-level names inside its own
-- reservation (see "Control.Monad.Foil.Blocks"), and the assignment of
-- reservations has to be /deterministic/: a unit's declarations are numbered
-- @base@, @base + 1@, and so on in declaration order, whatever else is
-- checked around it. Determinism is what makes raw names cacheable, since a
-- unit checked today and a unit loaded tomorrow then agree name for name. It
-- is also what discharges the trust obligation of
-- 'Control.Monad.Foil.Blocks.checkExtScope'.
--
-- The registry is that assignment: an append-only map from unit names to
-- stripe indices, handing out the next index on first use. A build persists
-- it beside the build products, since a cached artifact survives a change
-- elsewhere in the build exactly when the assignment does not move.
--
-- Where the stripes lie on the raw-name line is a 'StripeLayout' and a
-- policy of the client. The library is region-agnostic, and the allocator
-- admits negative names.
module Control.Monad.Foil.Registry (
  -- * Stripe indices
  StripeIndex (..),
  -- * Layouts
  StripeSize (..),
  StripeLayout (..),
  stripesBelowZero,
  stripesAbove,
  -- * Local-region layouts
  RegionWidth (..),
  RegionsPerUnit (..),
  RegionLayout (..),
  regionsAbove,
  -- * The registry
  Registry,
  emptyRegistry,
  registrySize,
  registerUnit,
) where

import           Data.Binary                 (Binary)
import           Data.Map                    (Map)
import qualified Data.Map                    as Map

import           Control.Monad.Foil.Internal (NameRange (..), RawName)

-- $setup
-- >>> import Control.Monad.Foil.Internal

-- | A stripe's position in the registry: which run of names a unit draws
-- from. Its own type, so that a stripe index cannot be confused with a name,
-- a count, or an offset.
--
-- @since 0.4.0
newtype StripeIndex = StripeIndex Int
  deriving newtype (StripeIndex -> StripeIndex -> Bool
(StripeIndex -> StripeIndex -> Bool)
-> (StripeIndex -> StripeIndex -> Bool) -> Eq StripeIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StripeIndex -> StripeIndex -> Bool
== :: StripeIndex -> StripeIndex -> Bool
$c/= :: StripeIndex -> StripeIndex -> Bool
/= :: StripeIndex -> StripeIndex -> Bool
Eq, Eq StripeIndex
Eq StripeIndex =>
(StripeIndex -> StripeIndex -> Ordering)
-> (StripeIndex -> StripeIndex -> Bool)
-> (StripeIndex -> StripeIndex -> Bool)
-> (StripeIndex -> StripeIndex -> Bool)
-> (StripeIndex -> StripeIndex -> Bool)
-> (StripeIndex -> StripeIndex -> StripeIndex)
-> (StripeIndex -> StripeIndex -> StripeIndex)
-> Ord StripeIndex
StripeIndex -> StripeIndex -> Bool
StripeIndex -> StripeIndex -> Ordering
StripeIndex -> StripeIndex -> StripeIndex
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: StripeIndex -> StripeIndex -> Ordering
compare :: StripeIndex -> StripeIndex -> Ordering
$c< :: StripeIndex -> StripeIndex -> Bool
< :: StripeIndex -> StripeIndex -> Bool
$c<= :: StripeIndex -> StripeIndex -> Bool
<= :: StripeIndex -> StripeIndex -> Bool
$c> :: StripeIndex -> StripeIndex -> Bool
> :: StripeIndex -> StripeIndex -> Bool
$c>= :: StripeIndex -> StripeIndex -> Bool
>= :: StripeIndex -> StripeIndex -> Bool
$cmax :: StripeIndex -> StripeIndex -> StripeIndex
max :: StripeIndex -> StripeIndex -> StripeIndex
$cmin :: StripeIndex -> StripeIndex -> StripeIndex
min :: StripeIndex -> StripeIndex -> StripeIndex
Ord, RawName -> StripeIndex -> ShowS
[StripeIndex] -> ShowS
StripeIndex -> String
(RawName -> StripeIndex -> ShowS)
-> (StripeIndex -> String)
-> ([StripeIndex] -> ShowS)
-> Show StripeIndex
forall a.
(RawName -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: RawName -> StripeIndex -> ShowS
showsPrec :: RawName -> StripeIndex -> ShowS
$cshow :: StripeIndex -> String
show :: StripeIndex -> String
$cshowList :: [StripeIndex] -> ShowS
showList :: [StripeIndex] -> ShowS
Show, ReadPrec [StripeIndex]
ReadPrec StripeIndex
RawName -> ReadS StripeIndex
ReadS [StripeIndex]
(RawName -> ReadS StripeIndex)
-> ReadS [StripeIndex]
-> ReadPrec StripeIndex
-> ReadPrec [StripeIndex]
-> Read StripeIndex
forall a.
(RawName -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: RawName -> ReadS StripeIndex
readsPrec :: RawName -> ReadS StripeIndex
$creadList :: ReadS [StripeIndex]
readList :: ReadS [StripeIndex]
$creadPrec :: ReadPrec StripeIndex
readPrec :: ReadPrec StripeIndex
$creadListPrec :: ReadPrec [StripeIndex]
readListPrec :: ReadPrec [StripeIndex]
Read, Get StripeIndex
[StripeIndex] -> Put
StripeIndex -> Put
(StripeIndex -> Put)
-> Get StripeIndex -> ([StripeIndex] -> Put) -> Binary StripeIndex
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: StripeIndex -> Put
put :: StripeIndex -> Put
$cget :: Get StripeIndex
get :: Get StripeIndex
$cputList :: [StripeIndex] -> Put
putList :: [StripeIndex] -> Put
Binary)

-- | How many names a unit may declare: the width of every stripe a layout
-- hands out. Its own type, so that a size cannot be confused with a name, an
-- index, or a base.
--
-- @since 0.4.0
newtype StripeSize = StripeSize Int
  deriving newtype (StripeSize -> StripeSize -> Bool
(StripeSize -> StripeSize -> Bool)
-> (StripeSize -> StripeSize -> Bool) -> Eq StripeSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StripeSize -> StripeSize -> Bool
== :: StripeSize -> StripeSize -> Bool
$c/= :: StripeSize -> StripeSize -> Bool
/= :: StripeSize -> StripeSize -> Bool
Eq, Eq StripeSize
Eq StripeSize =>
(StripeSize -> StripeSize -> Ordering)
-> (StripeSize -> StripeSize -> Bool)
-> (StripeSize -> StripeSize -> Bool)
-> (StripeSize -> StripeSize -> Bool)
-> (StripeSize -> StripeSize -> Bool)
-> (StripeSize -> StripeSize -> StripeSize)
-> (StripeSize -> StripeSize -> StripeSize)
-> Ord StripeSize
StripeSize -> StripeSize -> Bool
StripeSize -> StripeSize -> Ordering
StripeSize -> StripeSize -> StripeSize
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: StripeSize -> StripeSize -> Ordering
compare :: StripeSize -> StripeSize -> Ordering
$c< :: StripeSize -> StripeSize -> Bool
< :: StripeSize -> StripeSize -> Bool
$c<= :: StripeSize -> StripeSize -> Bool
<= :: StripeSize -> StripeSize -> Bool
$c> :: StripeSize -> StripeSize -> Bool
> :: StripeSize -> StripeSize -> Bool
$c>= :: StripeSize -> StripeSize -> Bool
>= :: StripeSize -> StripeSize -> Bool
$cmax :: StripeSize -> StripeSize -> StripeSize
max :: StripeSize -> StripeSize -> StripeSize
$cmin :: StripeSize -> StripeSize -> StripeSize
min :: StripeSize -> StripeSize -> StripeSize
Ord, RawName -> StripeSize -> ShowS
[StripeSize] -> ShowS
StripeSize -> String
(RawName -> StripeSize -> ShowS)
-> (StripeSize -> String)
-> ([StripeSize] -> ShowS)
-> Show StripeSize
forall a.
(RawName -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: RawName -> StripeSize -> ShowS
showsPrec :: RawName -> StripeSize -> ShowS
$cshow :: StripeSize -> String
show :: StripeSize -> String
$cshowList :: [StripeSize] -> ShowS
showList :: [StripeSize] -> ShowS
Show, ReadPrec [StripeSize]
ReadPrec StripeSize
RawName -> ReadS StripeSize
ReadS [StripeSize]
(RawName -> ReadS StripeSize)
-> ReadS [StripeSize]
-> ReadPrec StripeSize
-> ReadPrec [StripeSize]
-> Read StripeSize
forall a.
(RawName -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: RawName -> ReadS StripeSize
readsPrec :: RawName -> ReadS StripeSize
$creadList :: ReadS [StripeSize]
readList :: ReadS [StripeSize]
$creadPrec :: ReadPrec StripeSize
readPrec :: ReadPrec StripeSize
$creadListPrec :: ReadPrec [StripeSize]
readListPrec :: ReadPrec [StripeSize]
Read)

-- | Where stripe @i@ lies on the raw-name line.
--
-- The library does not choose: whether stripes descend below zero, ascend
-- from some base, or interleave with other reservations is a policy of the
-- client, and everything in "Control.Monad.Foil.Blocks" works from the
-- resulting 'NameRange's alone. A layout should give disjoint ranges to
-- distinct indices. Nothing checks this here, but
-- 'Control.Monad.Foil.Blocks.withDisjointUnion' refuses the overlap at the
-- point where it would do harm.
--
-- @since 0.4.0
newtype StripeLayout = StripeLayout
  { StripeLayout -> StripeIndex -> NameRange
stripeRange :: StripeIndex -> NameRange
  }

-- | Stripe @i@ is the @i@-th run of @size@ names below zero, counting
-- downwards, so stripe 0 is @[-size .. -1]@. Within a stripe, allocation
-- still ascends (see 'Control.Monad.Foil.withFreshIn'), so declaration order
-- is ascending name order.
--
-- This layout leaves the whole non-negative range free for a client's local
-- names.
--
-- >>> stripeRange (stripesBelowZero (StripeSize 100)) (StripeIndex 0)
-- NameRange {nameRangeLo = -100, nameRangeHi = -1}
-- >>> stripeRange (stripesBelowZero (StripeSize 100)) (StripeIndex 2)
-- NameRange {nameRangeLo = -300, nameRangeHi = -201}
--
-- @since 0.4.0
stripesBelowZero :: StripeSize -> StripeLayout
stripesBelowZero :: StripeSize -> StripeLayout
stripesBelowZero (StripeSize RawName
size) = (StripeIndex -> NameRange) -> StripeLayout
StripeLayout ((StripeIndex -> NameRange) -> StripeLayout)
-> (StripeIndex -> NameRange) -> StripeLayout
forall a b. (a -> b) -> a -> b
$ \(StripeIndex RawName
i) ->
  let hi :: RawName
hi = RawName -> RawName
forall a. Num a => a -> a
negate (RawName
i RawName -> RawName -> RawName
forall a. Num a => a -> a -> a
* RawName
size) RawName -> RawName -> RawName
forall a. Num a => a -> a -> a
- RawName
1
   in RawName -> RawName -> NameRange
NameRange (RawName
hi RawName -> RawName -> RawName
forall a. Num a => a -> a -> a
- RawName
size RawName -> RawName -> RawName
forall a. Num a => a -> a -> a
+ RawName
1) RawName
hi

-- | Stripe @i@ is the @i@-th run of @size@ names at or above a base,
-- counting upwards, so stripe 0 is @[base .. base + size - 1]@.
--
-- >>> stripeRange (stripesAbove 0 (StripeSize 100)) (StripeIndex 1)
-- NameRange {nameRangeLo = 100, nameRangeHi = 199}
--
-- @since 0.4.0
stripesAbove
  :: RawName     -- ^ The base: the low end of stripe 0.
  -> StripeSize
  -> StripeLayout
stripesAbove :: RawName -> StripeSize -> StripeLayout
stripesAbove RawName
base (StripeSize RawName
size) = (StripeIndex -> NameRange) -> StripeLayout
StripeLayout ((StripeIndex -> NameRange) -> StripeLayout)
-> (StripeIndex -> NameRange) -> StripeLayout
forall a b. (a -> b) -> a -> b
$ \(StripeIndex RawName
i) ->
  let lo :: RawName
lo = RawName
base RawName -> RawName -> RawName
forall a. Num a => a -> a -> a
+ RawName
i RawName -> RawName -> RawName
forall a. Num a => a -> a -> a
* RawName
size
   in RawName -> RawName -> NameRange
NameRange RawName
lo (RawName
lo RawName -> RawName -> RawName
forall a. Num a => a -> a -> a
+ RawName
size RawName -> RawName -> RawName
forall a. Num a => a -> a -> a
- RawName
1)

-- | Which stripe each unit's declarations live in, by the unit's name.
--
-- Append-only: a name, once registered, keeps its stripe for the lifetime of
-- the registry, and the next stripe index is always the registry's size.
--
-- @since 0.4.0
type Registry name = Map name StripeIndex

-- | The registry before any unit has ever been checked.
--
-- @since 0.4.0
emptyRegistry :: Registry name
emptyRegistry :: forall name. Registry name
emptyRegistry = Map name StripeIndex
forall k a. Map k a
Map.empty

-- | How many units have been registered, which is also the next free stripe.
--
-- @since 0.4.0
registrySize :: Registry name -> Int
registrySize :: forall name. Registry name -> RawName
registrySize = Map name StripeIndex -> RawName
forall k a. Map k a -> RawName
Map.size

-- | The stripe index of a unit, assigning the next one on first use.
--
-- Registration hands out the index and not a range. A unit's index
-- determines /every/ reservation derived for it: its stripe under a
-- 'StripeLayout', and its runs of local names under a 'RegionLayout'. The
-- layouts interpret the index, rather than being consulted here.
--
-- >>> let layout = stripesBelowZero (StripeSize 10)
-- >>> let (r1, iA) = registerUnit "A" emptyRegistry
-- >>> stripeRange layout iA
-- NameRange {nameRangeLo = -10, nameRangeHi = -1}
-- >>> stripeRange layout (snd (registerUnit "B" r1))
-- NameRange {nameRangeLo = -20, nameRangeHi = -11}
--
-- Registration is idempotent, which is the determinism a cache rests on:
--
-- >>> snd (registerUnit "A" r1) == iA
-- True
--
-- @since 0.4.0
registerUnit
  :: Ord name
  => name -> Registry name -> (Registry name, StripeIndex)
registerUnit :: forall name.
Ord name =>
name -> Registry name -> (Registry name, StripeIndex)
registerUnit name
name Registry name
registry = case name -> Registry name -> Maybe StripeIndex
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup name
name Registry name
registry of
  Just StripeIndex
i  -> (Registry name
registry, StripeIndex
i)
  Maybe StripeIndex
Nothing ->
    let i :: StripeIndex
i = RawName -> StripeIndex
StripeIndex (Registry name -> RawName
forall k a. Map k a -> RawName
Map.size Registry name
registry)
     in (name -> StripeIndex -> Registry name -> Registry name
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert name
name StripeIndex
i Registry name
registry, StripeIndex
i)

-- * Local-region layouts

-- | How far apart consecutive local-region floors sit within a unit's runs.
-- This is spacing, not a hard width: a run is open-ended above its floor,
-- and a scope-driven allocator would have to hold this many names /in scope
-- at once/ to reach the next floor.
--
-- @since 0.4.0
newtype RegionWidth = RegionWidth Int
  deriving newtype (RegionWidth -> RegionWidth -> Bool
(RegionWidth -> RegionWidth -> Bool)
-> (RegionWidth -> RegionWidth -> Bool) -> Eq RegionWidth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RegionWidth -> RegionWidth -> Bool
== :: RegionWidth -> RegionWidth -> Bool
$c/= :: RegionWidth -> RegionWidth -> Bool
/= :: RegionWidth -> RegionWidth -> Bool
Eq, Eq RegionWidth
Eq RegionWidth =>
(RegionWidth -> RegionWidth -> Ordering)
-> (RegionWidth -> RegionWidth -> Bool)
-> (RegionWidth -> RegionWidth -> Bool)
-> (RegionWidth -> RegionWidth -> Bool)
-> (RegionWidth -> RegionWidth -> Bool)
-> (RegionWidth -> RegionWidth -> RegionWidth)
-> (RegionWidth -> RegionWidth -> RegionWidth)
-> Ord RegionWidth
RegionWidth -> RegionWidth -> Bool
RegionWidth -> RegionWidth -> Ordering
RegionWidth -> RegionWidth -> RegionWidth
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RegionWidth -> RegionWidth -> Ordering
compare :: RegionWidth -> RegionWidth -> Ordering
$c< :: RegionWidth -> RegionWidth -> Bool
< :: RegionWidth -> RegionWidth -> Bool
$c<= :: RegionWidth -> RegionWidth -> Bool
<= :: RegionWidth -> RegionWidth -> Bool
$c> :: RegionWidth -> RegionWidth -> Bool
> :: RegionWidth -> RegionWidth -> Bool
$c>= :: RegionWidth -> RegionWidth -> Bool
>= :: RegionWidth -> RegionWidth -> Bool
$cmax :: RegionWidth -> RegionWidth -> RegionWidth
max :: RegionWidth -> RegionWidth -> RegionWidth
$cmin :: RegionWidth -> RegionWidth -> RegionWidth
min :: RegionWidth -> RegionWidth -> RegionWidth
Ord, RawName -> RegionWidth -> ShowS
[RegionWidth] -> ShowS
RegionWidth -> String
(RawName -> RegionWidth -> ShowS)
-> (RegionWidth -> String)
-> ([RegionWidth] -> ShowS)
-> Show RegionWidth
forall a.
(RawName -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: RawName -> RegionWidth -> ShowS
showsPrec :: RawName -> RegionWidth -> ShowS
$cshow :: RegionWidth -> String
show :: RegionWidth -> String
$cshowList :: [RegionWidth] -> ShowS
showList :: [RegionWidth] -> ShowS
Show, ReadPrec [RegionWidth]
ReadPrec RegionWidth
RawName -> ReadS RegionWidth
ReadS [RegionWidth]
(RawName -> ReadS RegionWidth)
-> ReadS [RegionWidth]
-> ReadPrec RegionWidth
-> ReadPrec [RegionWidth]
-> Read RegionWidth
forall a.
(RawName -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: RawName -> ReadS RegionWidth
readsPrec :: RawName -> ReadS RegionWidth
$creadList :: ReadS [RegionWidth]
readList :: ReadS [RegionWidth]
$creadPrec :: ReadPrec RegionWidth
readPrec :: ReadPrec RegionWidth
$creadListPrec :: ReadPrec [RegionWidth]
readListPrec :: ReadPrec [RegionWidth]
Read)

-- | How many runs of local names a unit may hold before its runs would
-- spill into the next unit's. A spill is not unsound for a client that
-- refreshes on clash. It only forfeits the disjointness described under
-- 'RegionLayout' for the runs past the cap.
--
-- @since 0.4.0
newtype RegionsPerUnit = RegionsPerUnit Int
  deriving newtype (RegionsPerUnit -> RegionsPerUnit -> Bool
(RegionsPerUnit -> RegionsPerUnit -> Bool)
-> (RegionsPerUnit -> RegionsPerUnit -> Bool) -> Eq RegionsPerUnit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RegionsPerUnit -> RegionsPerUnit -> Bool
== :: RegionsPerUnit -> RegionsPerUnit -> Bool
$c/= :: RegionsPerUnit -> RegionsPerUnit -> Bool
/= :: RegionsPerUnit -> RegionsPerUnit -> Bool
Eq, Eq RegionsPerUnit
Eq RegionsPerUnit =>
(RegionsPerUnit -> RegionsPerUnit -> Ordering)
-> (RegionsPerUnit -> RegionsPerUnit -> Bool)
-> (RegionsPerUnit -> RegionsPerUnit -> Bool)
-> (RegionsPerUnit -> RegionsPerUnit -> Bool)
-> (RegionsPerUnit -> RegionsPerUnit -> Bool)
-> (RegionsPerUnit -> RegionsPerUnit -> RegionsPerUnit)
-> (RegionsPerUnit -> RegionsPerUnit -> RegionsPerUnit)
-> Ord RegionsPerUnit
RegionsPerUnit -> RegionsPerUnit -> Bool
RegionsPerUnit -> RegionsPerUnit -> Ordering
RegionsPerUnit -> RegionsPerUnit -> RegionsPerUnit
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RegionsPerUnit -> RegionsPerUnit -> Ordering
compare :: RegionsPerUnit -> RegionsPerUnit -> Ordering
$c< :: RegionsPerUnit -> RegionsPerUnit -> Bool
< :: RegionsPerUnit -> RegionsPerUnit -> Bool
$c<= :: RegionsPerUnit -> RegionsPerUnit -> Bool
<= :: RegionsPerUnit -> RegionsPerUnit -> Bool
$c> :: RegionsPerUnit -> RegionsPerUnit -> Bool
> :: RegionsPerUnit -> RegionsPerUnit -> Bool
$c>= :: RegionsPerUnit -> RegionsPerUnit -> Bool
>= :: RegionsPerUnit -> RegionsPerUnit -> Bool
$cmax :: RegionsPerUnit -> RegionsPerUnit -> RegionsPerUnit
max :: RegionsPerUnit -> RegionsPerUnit -> RegionsPerUnit
$cmin :: RegionsPerUnit -> RegionsPerUnit -> RegionsPerUnit
min :: RegionsPerUnit -> RegionsPerUnit -> RegionsPerUnit
Ord, RawName -> RegionsPerUnit -> ShowS
[RegionsPerUnit] -> ShowS
RegionsPerUnit -> String
(RawName -> RegionsPerUnit -> ShowS)
-> (RegionsPerUnit -> String)
-> ([RegionsPerUnit] -> ShowS)
-> Show RegionsPerUnit
forall a.
(RawName -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: RawName -> RegionsPerUnit -> ShowS
showsPrec :: RawName -> RegionsPerUnit -> ShowS
$cshow :: RegionsPerUnit -> String
show :: RegionsPerUnit -> String
$cshowList :: [RegionsPerUnit] -> ShowS
showList :: [RegionsPerUnit] -> ShowS
Show, ReadPrec [RegionsPerUnit]
ReadPrec RegionsPerUnit
RawName -> ReadS RegionsPerUnit
ReadS [RegionsPerUnit]
(RawName -> ReadS RegionsPerUnit)
-> ReadS [RegionsPerUnit]
-> ReadPrec RegionsPerUnit
-> ReadPrec [RegionsPerUnit]
-> Read RegionsPerUnit
forall a.
(RawName -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: RawName -> ReadS RegionsPerUnit
readsPrec :: RawName -> ReadS RegionsPerUnit
$creadList :: ReadS [RegionsPerUnit]
readList :: ReadS [RegionsPerUnit]
$creadPrec :: ReadPrec RegionsPerUnit
readPrec :: ReadPrec RegionsPerUnit
$creadListPrec :: ReadPrec [RegionsPerUnit]
readListPrec :: ReadPrec [RegionsPerUnit]
Read)

-- | Where a unit's runs of /local/ names lie: one open-ended region per
-- declaration (or command) of the unit, advanced with 'nextRegion' as the
-- unit's declarations are processed.
--
-- Stripes make a unit's top-level names disjoint from every other unit's,
-- and runs of local regions do the same for the names a checker invents
-- /inside/ a declaration. A term stored under one declaration then never
-- collides with another declaration's live locals when it is reopened, so a
-- refreshing substitution takes its no-rename fast path throughout.
--
-- The first run is derived from the unit's stripe index rather than from a
-- counter shared across units, so a unit's elaboration depends only on the
-- unit itself and editing a neighbour moves no name. That is the
-- determinism a cache rests on.
--
-- The trade-off is that local names carry large offsets. A client that
-- shows raw indices directly may prefer a single flat region, and accept
-- the transient renames instead.
--
-- @since 0.4.0
data RegionLayout = RegionLayout
  { RegionLayout -> StripeIndex -> NameRange
firstRegionOf :: StripeIndex -> NameRange
    -- ^ The run of the unit's first declaration.
  , RegionLayout -> NameRange -> NameRange
nextRegion    :: NameRange -> NameRange
    -- ^ The next declaration's run.
  }

-- | Runs ascending from a base: the unit with stripe index @i@ starts its
-- runs at @base + i * perUnit * width@, and each declaration's floor sits
-- @width@ above the previous one. The top of every run is open.
--
-- >>> let locals = regionsAbove 0 (RegionsPerUnit 0x10) (RegionWidth 0x100)
-- >>> nameRangeLo (firstRegionOf locals (StripeIndex 2))
-- 8192
-- >>> nameRangeLo (nextRegion locals (firstRegionOf locals (StripeIndex 2)))
-- 8448
--
-- @since 0.4.0
regionsAbove :: RawName -> RegionsPerUnit -> RegionWidth -> RegionLayout
regionsAbove :: RawName -> RegionsPerUnit -> RegionWidth -> RegionLayout
regionsAbove RawName
base (RegionsPerUnit RawName
perUnit) (RegionWidth RawName
w) = RegionLayout
  { firstRegionOf :: StripeIndex -> NameRange
firstRegionOf = \(StripeIndex RawName
i) ->
      RawName -> RawName -> NameRange
NameRange (RawName
base RawName -> RawName -> RawName
forall a. Num a => a -> a -> a
+ RawName
i RawName -> RawName -> RawName
forall a. Num a => a -> a -> a
* RawName
perUnit RawName -> RawName -> RawName
forall a. Num a => a -> a -> a
* RawName
w) RawName
forall a. Bounded a => a
maxBound
  , nextRegion :: NameRange -> NameRange
nextRegion = \(NameRange RawName
lo RawName
_) -> RawName -> RawName -> NameRange
NameRange (RawName
lo RawName -> RawName -> RawName
forall a. Num a => a -> a -> a
+ RawName
w) RawName
forall a. Bounded a => a
maxBound
  }