{-# LANGUAGE DerivingStrategies, GeneralizedNewtypeDeriving #-}
module RetroClash.Memory
    ( RAM, ROM, Port, Port_
    , packRam

    , Handle
    , mapH

    , Addressing
    , memoryMap, memoryMap_

    , conduit, readWrite, readWrite_
    , romFromVec, romFromFile
    , ram0, ramFromFile
    , port, port_

    , connect
    , override

    , from
    , matchJust
    , matchLeft, matchRight
    , tag
    ) where

import Clash.Prelude hiding (Exp, lift)
import RetroClash.Utils
import RetroClash.Port
import Data.Maybe
import Control.Arrow (second)
import Control.Monad
import Control.Monad.Reader
import Control.Monad.Writer
import Data.Kind (Type)

import Data.List as L
import Data.Map.Monoidal as Map

import Language.Haskell.TH hiding (Type)
import Language.Haskell.TH.Instances ()
import LiftType
import Type.Reflection (Typeable)

type RAM dom addr dat = Signal dom addr -> Signal dom (Maybe (addr, dat)) -> Signal dom dat
type ROM dom addr dat = Signal dom addr ->                                   Signal dom dat
type Port dom addr dat a = Signal dom (Maybe (PortCommand addr dat)) -> (Signal dom dat, a)
type Port_ dom addr dat = Signal dom (Maybe (PortCommand addr dat)) -> Signal dom dat

packRam :: (BitPack dat) => RAM dom addr (BitVector (BitSize dat)) -> RAM dom addr dat
packRam :: forall dat (dom :: Domain) addr.
BitPack dat =>
RAM dom addr (BitVector (BitSize dat)) -> RAM dom addr dat
packRam RAM dom addr (BitVector (BitSize dat))
ram Signal dom addr
addr = (BitVector (BitSize dat) -> dat)
-> Signal dom (BitVector (BitSize dat)) -> Signal dom dat
forall a b. (a -> b) -> Signal dom a -> Signal dom b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap BitVector (BitSize dat) -> dat
forall a. BitPack a => BitVector (BitSize a) -> a
unpack (Signal dom (BitVector (BitSize dat)) -> Signal dom dat)
-> (Signal dom (Maybe (addr, dat))
    -> Signal dom (BitVector (BitSize dat)))
-> Signal dom (Maybe (addr, dat))
-> Signal dom dat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RAM dom addr (BitVector (BitSize dat))
ram Signal dom addr
addr (Signal dom (Maybe (addr, BitVector (BitSize dat)))
 -> Signal dom (BitVector (BitSize dat)))
-> (Signal dom (Maybe (addr, dat))
    -> Signal dom (Maybe (addr, BitVector (BitSize dat))))
-> Signal dom (Maybe (addr, dat))
-> Signal dom (BitVector (BitSize dat))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (addr, dat) -> Maybe (addr, BitVector (BitSize dat)))
-> Signal dom (Maybe (addr, dat))
-> Signal dom (Maybe (addr, BitVector (BitSize dat)))
forall a b. (a -> b) -> Signal dom a -> Signal dom b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((dat -> BitVector (BitSize dat))
-> (addr, dat) -> (addr, BitVector (BitSize dat))
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second dat -> BitVector (BitSize dat)
forall a. BitPack a => a -> BitVector (BitSize a)
pack ((addr, dat) -> (addr, BitVector (BitSize dat)))
-> Maybe (addr, dat) -> Maybe (addr, BitVector (BitSize dat))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>)

data Handle addr = Handle Name Name

-- | type Addr dom addr = TExpQ (Signal dom (Maybe addr))
type Addr = ExpQ

-- | type Dat dom dat = TExpQ (Signal dom (Maybe dat))
type Dat = ExpQ

-- | type Component dom dat a = TExpQ (Signal dom (Maybe dat))
type Component = ExpQ

newtype Addressing addr a = Addressing
    { forall addr a.
Addressing addr a
-> ReaderT
     (Addr, Addr) (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q) a
runAddressing :: ReaderT (Addr, Dat) (WriterT (DecsQ, MonoidalMap Name [Addr], [Component]) Q) a }
    deriving newtype ((forall a b. (a -> b) -> Addressing addr a -> Addressing addr b)
-> (forall a b. a -> Addressing addr b -> Addressing addr a)
-> Functor (Addressing addr)
forall a b. a -> Addressing addr b -> Addressing addr a
forall a b. (a -> b) -> Addressing addr a -> Addressing addr b
forall addr a b. a -> Addressing addr b -> Addressing addr a
forall addr a b. (a -> b) -> Addressing addr a -> Addressing addr b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall addr a b. (a -> b) -> Addressing addr a -> Addressing addr b
fmap :: forall a b. (a -> b) -> Addressing addr a -> Addressing addr b
$c<$ :: forall addr a b. a -> Addressing addr b -> Addressing addr a
<$ :: forall a b. a -> Addressing addr b -> Addressing addr a
Functor, Functor (Addressing addr)
Functor (Addressing addr) =>
(forall a. a -> Addressing addr a)
-> (forall a b.
    Addressing addr (a -> b) -> Addressing addr a -> Addressing addr b)
-> (forall a b c.
    (a -> b -> c)
    -> Addressing addr a -> Addressing addr b -> Addressing addr c)
-> (forall a b.
    Addressing addr a -> Addressing addr b -> Addressing addr b)
-> (forall a b.
    Addressing addr a -> Addressing addr b -> Addressing addr a)
-> Applicative (Addressing addr)
forall addr. Functor (Addressing addr)
forall a. a -> Addressing addr a
forall addr a. a -> Addressing addr a
forall a b.
Addressing addr a -> Addressing addr b -> Addressing addr a
forall a b.
Addressing addr a -> Addressing addr b -> Addressing addr b
forall a b.
Addressing addr (a -> b) -> Addressing addr a -> Addressing addr b
forall addr a b.
Addressing addr a -> Addressing addr b -> Addressing addr a
forall addr a b.
Addressing addr a -> Addressing addr b -> Addressing addr b
forall addr a b.
Addressing addr (a -> b) -> Addressing addr a -> Addressing addr b
forall a b c.
(a -> b -> c)
-> Addressing addr a -> Addressing addr b -> Addressing addr c
forall addr a b c.
(a -> b -> c)
-> Addressing addr a -> Addressing addr b -> Addressing addr c
forall (f :: Type -> Type).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall addr a. a -> Addressing addr a
pure :: forall a. a -> Addressing addr a
$c<*> :: forall addr a b.
Addressing addr (a -> b) -> Addressing addr a -> Addressing addr b
<*> :: forall a b.
Addressing addr (a -> b) -> Addressing addr a -> Addressing addr b
$cliftA2 :: forall addr a b c.
(a -> b -> c)
-> Addressing addr a -> Addressing addr b -> Addressing addr c
liftA2 :: forall a b c.
(a -> b -> c)
-> Addressing addr a -> Addressing addr b -> Addressing addr c
$c*> :: forall addr a b.
Addressing addr a -> Addressing addr b -> Addressing addr b
*> :: forall a b.
Addressing addr a -> Addressing addr b -> Addressing addr b
$c<* :: forall addr a b.
Addressing addr a -> Addressing addr b -> Addressing addr a
<* :: forall a b.
Addressing addr a -> Addressing addr b -> Addressing addr a
Applicative, Applicative (Addressing addr)
Applicative (Addressing addr) =>
(forall a b.
 Addressing addr a -> (a -> Addressing addr b) -> Addressing addr b)
-> (forall a b.
    Addressing addr a -> Addressing addr b -> Addressing addr b)
-> (forall a. a -> Addressing addr a)
-> Monad (Addressing addr)
forall addr. Applicative (Addressing addr)
forall a. a -> Addressing addr a
forall addr a. a -> Addressing addr a
forall a b.
Addressing addr a -> Addressing addr b -> Addressing addr b
forall a b.
Addressing addr a -> (a -> Addressing addr b) -> Addressing addr b
forall addr a b.
Addressing addr a -> Addressing addr b -> Addressing addr b
forall addr a b.
Addressing addr a -> (a -> Addressing addr b) -> Addressing addr b
forall (m :: Type -> Type).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall addr a b.
Addressing addr a -> (a -> Addressing addr b) -> Addressing addr b
>>= :: forall a b.
Addressing addr a -> (a -> Addressing addr b) -> Addressing addr b
$c>> :: forall addr a b.
Addressing addr a -> Addressing addr b -> Addressing addr b
>> :: forall a b.
Addressing addr a -> Addressing addr b -> Addressing addr b
$creturn :: forall addr a. a -> Addressing addr a
return :: forall a. a -> Addressing addr a
Monad)

class Backpane a where
    backpane :: a -> ExpQ

instance Backpane () where
    backpane :: () -> Addr
backpane () = [|()|]

instance (Backpane a1, Backpane a2) => Backpane (a1, a2) where
    backpane :: (a1, a2) -> Addr
backpane (a1
x1, a2
x2) = [| ($(a1 -> Addr
forall a. Backpane a => a -> Addr
backpane a1
x1), $(a2 -> Addr
forall a. Backpane a => a -> Addr
backpane a2
x2)) |]

instance (Backpane a1, Backpane a2, Backpane a3) => Backpane (a1, a2, a3) where
    backpane :: (a1, a2, a3) -> Addr
backpane (a1
x1, a2
x2, a3
x3) = [| ($(a1 -> Addr
forall a. Backpane a => a -> Addr
backpane a1
x1), $(a2 -> Addr
forall a. Backpane a => a -> Addr
backpane a2
x2), $(a3 -> Addr
forall a. Backpane a => a -> Addr
backpane a3
x3)) |]

data Result = Result ExpQ

instance Backpane Result where
    backpane :: Result -> Addr
backpane (Result Addr
e) = Addr
e

compile
    :: forall addr a b. (Backpane a)
    => Addressing addr a
    -> Addr
    -> Dat
    -> Component
compile :: forall addr a b.
Backpane a =>
Addressing addr a -> Addr -> Addr -> Addr
compile Addressing addr a
addressing Addr
addr Addr
wr = do
    (a
x, (DecsQ
decs, MonoidalMap Name [Addr]
conns, [Addr]
rds)) <-
        WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q a
-> Q (a, (DecsQ, MonoidalMap Name [Addr], [Addr]))
forall w (m :: Type -> Type) a. WriterT w m a -> m (a, w)
runWriterT (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q a
 -> Q (a, (DecsQ, MonoidalMap Name [Addr], [Addr])))
-> WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q a
-> Q (a, (DecsQ, MonoidalMap Name [Addr], [Addr]))
forall a b. (a -> b) -> a -> b
$ ReaderT
  (Addr, Addr) (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q) a
-> (Addr, Addr)
-> WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q a
forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
runReaderT (Addressing addr a
-> ReaderT
     (Addr, Addr) (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q) a
forall addr a.
Addressing addr a
-> ReaderT
     (Addr, Addr) (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q) a
runAddressing Addressing addr a
addressing) ([| Just <$> $Addr
addr |], Addr
wr)

    let compAddrs :: [DecsQ]
compAddrs = [ [d| $(Name -> Q Pat
forall (m :: Type -> Type). Quote m => Name -> m Pat
varP Name
nm) = muxA $([Addr] -> Addr
forall (m :: Type -> Type). Quote m => [m Exp] -> m Exp
listE [Addr]
addrs) |]
                    | (Name
nm, [Addr]
addrs) <- MonoidalMap Name [Addr] -> [(Name, [Addr])]
forall k a. MonoidalMap k a -> [(k, a)]
Map.toList MonoidalMap Name [Addr]
conns
                    ]
    [Dec]
decs <- [DecsQ] -> DecsQ
forall a. Monoid a => [a] -> a
mconcat (DecsQ
decsDecsQ -> [DecsQ] -> [DecsQ]
forall a. a -> [a] -> [a]
:[DecsQ]
compAddrs)
    [Q Dec] -> Addr -> Addr
forall (m :: Type -> Type). Quote m => [m Dec] -> m Exp -> m Exp
letE (Dec -> Q Dec
forall a. a -> Q a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Dec -> Q Dec) -> [Dec] -> [Q Dec]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [Dec]
decs) [| (muxA $([Addr] -> Addr
forall (m :: Type -> Type). Quote m => [m Exp] -> m Exp
listE [Addr]
rds), $(a -> Addr
forall a. Backpane a => a -> Addr
backpane a
x)) |]

memoryMap
    :: forall addr a. (Backpane a)
    => Addr
    -> Dat
    -> Addressing addr a
    -> Component
memoryMap :: forall addr a.
Backpane a =>
Addr -> Addr -> Addressing addr a -> Addr
memoryMap Addr
addr Addr
wr Addressing addr a
addressing =
    [| let addr' = $Addr
addr; wr' = $Addr
wr
        in $(Addressing addr a -> Addr -> Addr -> Addr
forall addr a b.
Backpane a =>
Addressing addr a -> Addr -> Addr -> Addr
compile Addressing addr a
addressing [| addr' |] [| wr' |])
    |]

memoryMap_
    :: forall addr dat. ()
    => Addr
    -> Dat
    -> Addressing addr ()
    -> Dat
memoryMap_ :: forall addr dat. Addr -> Addr -> Addressing addr () -> Addr
memoryMap_ Addr
addr Addr
wr Addressing addr ()
addressing = [| fst $(Addr -> Addr -> Addressing addr () -> Addr
forall addr a.
Backpane a =>
Addr -> Addr -> Addressing addr a -> Addr
memoryMap Addr
addr Addr
wr Addressing addr ()
addressing) |]

connect
    :: Handle addr
    -> Addressing addr ()
connect :: forall addr. Handle addr -> Addressing addr ()
connect (Handle Name
rd Name
compAddr) = ReaderT
  (Addr, Addr)
  (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
  ()
-> Addressing addr ()
forall addr a.
ReaderT
  (Addr, Addr) (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q) a
-> Addressing addr a
Addressing (ReaderT
   (Addr, Addr)
   (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
   ()
 -> Addressing addr ())
-> ReaderT
     (Addr, Addr)
     (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
     ()
-> Addressing addr ()
forall a b. (a -> b) -> a -> b
$ do
    (Addr
addr, Addr
_) <- ReaderT
  (Addr, Addr)
  (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
  (Addr, Addr)
forall r (m :: Type -> Type). MonadReader r m => m r
ask
    let masked :: Addr
masked = [| enable (delay False $ isJust <$> $Addr
addr) $(Name -> Addr
forall (m :: Type -> Type). Quote m => Name -> m Exp
varE Name
rd) |]
    (DecsQ, MonoidalMap Name [Addr], [Addr])
-> ReaderT
     (Addr, Addr)
     (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
     ()
forall w (m :: Type -> Type). MonadWriter w m => w -> m ()
tell (DecsQ
forall a. Monoid a => a
mempty, Name -> [Addr] -> MonoidalMap Name [Addr]
forall k a. k -> a -> MonoidalMap k a
Map.singleton Name
compAddr [Addr
addr], [Addr
masked])

override
    :: ExpQ
    -> Addressing addr ()
override :: forall addr. Addr -> Addressing addr ()
override Addr
sig = ReaderT
  (Addr, Addr)
  (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
  ()
-> Addressing addr ()
forall addr a.
ReaderT
  (Addr, Addr) (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q) a
-> Addressing addr a
Addressing (ReaderT
   (Addr, Addr)
   (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
   ()
 -> Addressing addr ())
-> ReaderT
     (Addr, Addr)
     (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
     ()
-> Addressing addr ()
forall a b. (a -> b) -> a -> b
$ do
    Name
rd <- WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q Name
-> ReaderT
     (Addr, Addr)
     (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
     Name
forall (m :: Type -> Type) a.
Monad m =>
m a -> ReaderT (Addr, Addr) m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q Name
 -> ReaderT
      (Addr, Addr)
      (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
      Name)
-> (Q Name
    -> WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q Name)
-> Q Name
-> ReaderT
     (Addr, Addr)
     (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
     Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Q Name -> WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q Name
forall (m :: Type -> Type) a.
Monad m =>
m a -> WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Name
 -> ReaderT
      (Addr, Addr)
      (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
      Name)
-> Q Name
-> ReaderT
     (Addr, Addr)
     (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
     Name
forall a b. (a -> b) -> a -> b
$ String -> Q Name
forall (m :: Type -> Type). Quote m => String -> m Name
newName String
"rd"
    let decs :: DecsQ
decs = [d| $(Name -> Q Pat
forall (m :: Type -> Type). Quote m => Name -> m Pat
varP Name
rd) = $Addr
sig |]
    (DecsQ, MonoidalMap Name [Addr], [Addr])
-> ReaderT
     (Addr, Addr)
     (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
     ()
forall w (m :: Type -> Type). MonadWriter w m => w -> m ()
tell (DecsQ
decs, MonoidalMap Name [Addr]
forall a. Monoid a => a
mempty, [Name -> Addr
forall (m :: Type -> Type). Quote m => Name -> m Exp
varE Name
rd])

matchAddr
    :: ExpQ {-(addr -> Maybe addr')-}
    -> Addressing addr' a
    -> Addressing addr a
matchAddr :: forall addr' a addr.
Addr -> Addressing addr' a -> Addressing addr a
matchAddr Addr
match Addressing addr' a
body = ReaderT
  (Addr, Addr) (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q) a
-> Addressing addr a
forall addr a.
ReaderT
  (Addr, Addr) (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q) a
-> Addressing addr a
Addressing (ReaderT
   (Addr, Addr) (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q) a
 -> Addressing addr a)
-> ReaderT
     (Addr, Addr) (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q) a
-> Addressing addr a
forall a b. (a -> b) -> a -> b
$ do
    Name
nm <- WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q Name
-> ReaderT
     (Addr, Addr)
     (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
     Name
forall (m :: Type -> Type) a.
Monad m =>
m a -> ReaderT (Addr, Addr) m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q Name
 -> ReaderT
      (Addr, Addr)
      (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
      Name)
-> (Q Name
    -> WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q Name)
-> Q Name
-> ReaderT
     (Addr, Addr)
     (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
     Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Q Name -> WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q Name
forall (m :: Type -> Type) a.
Monad m =>
m a -> WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Name
 -> ReaderT
      (Addr, Addr)
      (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
      Name)
-> Q Name
-> ReaderT
     (Addr, Addr)
     (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
     Name
forall a b. (a -> b) -> a -> b
$ String -> Q Name
forall (m :: Type -> Type). Quote m => String -> m Name
newName String
"addr"
    let addr' :: Addr
addr' = Name -> Addr
forall (m :: Type -> Type). Quote m => Name -> m Exp
varE Name
nm
    ((Addr, Addr)
 -> WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q a)
-> ReaderT
     (Addr, Addr) (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q) a
forall r (m :: Type -> Type) a. (r -> m a) -> ReaderT r m a
ReaderT (((Addr, Addr)
  -> WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q a)
 -> ReaderT
      (Addr, Addr)
      (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
      a)
-> ((Addr, Addr)
    -> WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q a)
-> ReaderT
     (Addr, Addr) (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q) a
forall a b. (a -> b) -> a -> b
$ \(Addr
addr, Addr
wr) -> do
        let dec :: DecsQ
dec = [d| $(Name -> Q Pat
forall (m :: Type -> Type). Quote m => Name -> m Pat
varP Name
nm) = ($Addr
match =<<) <$> $Addr
addr |]
        ReaderT
  (Addr, Addr) (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q) a
-> (Addr, Addr)
-> WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q a
forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
runReaderT
          ((DecsQ, MonoidalMap Name [Addr], [Addr])
-> ReaderT
     (Addr, Addr)
     (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
     ()
forall w (m :: Type -> Type). MonadWriter w m => w -> m ()
tell (DecsQ
dec, MonoidalMap Name [Addr]
forall a. Monoid a => a
mempty, [Addr]
forall a. Monoid a => a
mempty) ReaderT
  (Addr, Addr)
  (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
  ()
-> ReaderT
     (Addr, Addr) (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q) a
-> ReaderT
     (Addr, Addr) (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q) a
forall a b.
ReaderT
  (Addr, Addr) (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q) a
-> ReaderT
     (Addr, Addr) (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q) b
-> ReaderT
     (Addr, Addr) (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q) b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> Addressing addr' a
-> ReaderT
     (Addr, Addr) (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q) a
forall addr a.
Addressing addr a
-> ReaderT
     (Addr, Addr) (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q) a
runAddressing Addressing addr' a
body)
          (Addr
addr', Addr
wr)

mapH :: ExpQ -> Handle addr' -> Addressing addr (Handle addr')
mapH :: forall addr' addr.
Addr -> Handle addr' -> Addressing addr (Handle addr')
mapH Addr
f (Handle Name
rd Name
compAddr) = ReaderT
  (Addr, Addr)
  (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
  (Handle addr')
-> Addressing addr (Handle addr')
forall addr a.
ReaderT
  (Addr, Addr) (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q) a
-> Addressing addr a
Addressing (ReaderT
   (Addr, Addr)
   (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
   (Handle addr')
 -> Addressing addr (Handle addr'))
-> ReaderT
     (Addr, Addr)
     (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
     (Handle addr')
-> Addressing addr (Handle addr')
forall a b. (a -> b) -> a -> b
$ do
    Name
rd' <- WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q Name
-> ReaderT
     (Addr, Addr)
     (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
     Name
forall (m :: Type -> Type) a.
Monad m =>
m a -> ReaderT (Addr, Addr) m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q Name
 -> ReaderT
      (Addr, Addr)
      (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
      Name)
-> (Q Name
    -> WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q Name)
-> Q Name
-> ReaderT
     (Addr, Addr)
     (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
     Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Q Name -> WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q Name
forall (m :: Type -> Type) a.
Monad m =>
m a -> WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Name
 -> ReaderT
      (Addr, Addr)
      (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
      Name)
-> Q Name
-> ReaderT
     (Addr, Addr)
     (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
     Name
forall a b. (a -> b) -> a -> b
$ String -> Q Name
forall (m :: Type -> Type). Quote m => String -> m Name
newName String
"rd"
    (DecsQ, MonoidalMap Name [Addr], [Addr])
-> ReaderT
     (Addr, Addr)
     (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
     ()
forall w (m :: Type -> Type). MonadWriter w m => w -> m ()
tell ([d| $(Name -> Q Pat
forall (m :: Type -> Type). Quote m => Name -> m Pat
varP Name
rd') = $Addr
f <$> $(Name -> Addr
forall (m :: Type -> Type). Quote m => Name -> m Exp
varE Name
rd)|], MonoidalMap Name [Addr]
forall a. Monoid a => a
mempty, [Addr]
forall a. Monoid a => a
mempty)
    Handle addr'
-> ReaderT
     (Addr, Addr)
     (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
     (Handle addr')
forall a.
a
-> ReaderT
     (Addr, Addr) (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Handle addr'
 -> ReaderT
      (Addr, Addr)
      (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
      (Handle addr'))
-> Handle addr'
-> ReaderT
     (Addr, Addr)
     (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
     (Handle addr')
forall a b. (a -> b) -> a -> b
$ Name -> Name -> Handle addr'
forall addr. Name -> Name -> Handle addr
Handle Name
rd' Name
compAddr

readWrite
    :: forall addr' addr. ()
    => (Addr -> Dat -> Component)
    -> Addressing addr (Handle addr', Result)
readWrite :: forall addr' addr.
(Addr -> Addr -> Addr) -> Addressing addr (Handle addr', Result)
readWrite Addr -> Addr -> Addr
component = ReaderT
  (Addr, Addr)
  (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
  (Handle addr', Result)
-> Addressing addr (Handle addr', Result)
forall addr a.
ReaderT
  (Addr, Addr) (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q) a
-> Addressing addr a
Addressing (ReaderT
   (Addr, Addr)
   (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
   (Handle addr', Result)
 -> Addressing addr (Handle addr', Result))
-> ReaderT
     (Addr, Addr)
     (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
     (Handle addr', Result)
-> Addressing addr (Handle addr', Result)
forall a b. (a -> b) -> a -> b
$ do
    Name
rd <- WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q Name
-> ReaderT
     (Addr, Addr)
     (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
     Name
forall (m :: Type -> Type) a.
Monad m =>
m a -> ReaderT (Addr, Addr) m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q Name
 -> ReaderT
      (Addr, Addr)
      (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
      Name)
-> (Q Name
    -> WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q Name)
-> Q Name
-> ReaderT
     (Addr, Addr)
     (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
     Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Q Name -> WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q Name
forall (m :: Type -> Type) a.
Monad m =>
m a -> WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Name
 -> ReaderT
      (Addr, Addr)
      (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
      Name)
-> Q Name
-> ReaderT
     (Addr, Addr)
     (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
     Name
forall a b. (a -> b) -> a -> b
$ String -> Q Name
forall (m :: Type -> Type). Quote m => String -> m Name
newName String
"rd"
    Name
addr <- WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q Name
-> ReaderT
     (Addr, Addr)
     (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
     Name
forall (m :: Type -> Type) a.
Monad m =>
m a -> ReaderT (Addr, Addr) m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q Name
 -> ReaderT
      (Addr, Addr)
      (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
      Name)
-> (Q Name
    -> WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q Name)
-> Q Name
-> ReaderT
     (Addr, Addr)
     (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
     Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Q Name -> WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q Name
forall (m :: Type -> Type) a.
Monad m =>
m a -> WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Name
 -> ReaderT
      (Addr, Addr)
      (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
      Name)
-> Q Name
-> ReaderT
     (Addr, Addr)
     (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
     Name
forall a b. (a -> b) -> a -> b
$ String -> Q Name
forall (m :: Type -> Type). Quote m => String -> m Name
newName String
"compAddr"
    Name
result <- WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q Name
-> ReaderT
     (Addr, Addr)
     (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
     Name
forall (m :: Type -> Type) a.
Monad m =>
m a -> ReaderT (Addr, Addr) m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q Name
 -> ReaderT
      (Addr, Addr)
      (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
      Name)
-> (Q Name
    -> WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q Name)
-> Q Name
-> ReaderT
     (Addr, Addr)
     (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
     Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Q Name -> WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q Name
forall (m :: Type -> Type) a.
Monad m =>
m a -> WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Name
 -> ReaderT
      (Addr, Addr)
      (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
      Name)
-> Q Name
-> ReaderT
     (Addr, Addr)
     (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
     Name
forall a b. (a -> b) -> a -> b
$ String -> Q Name
forall (m :: Type -> Type). Quote m => String -> m Name
newName String
"result"
    (Addr
_, Addr
wr) <- ReaderT
  (Addr, Addr)
  (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
  (Addr, Addr)
forall r (m :: Type -> Type). MonadReader r m => m r
ask
    let decs :: DecsQ
decs = [d| ($(Name -> Q Pat
forall (m :: Type -> Type). Quote m => Name -> m Pat
varP Name
rd), $(Name -> Q Pat
forall (m :: Type -> Type). Quote m => Name -> m Pat
varP Name
result)) = $(Addr -> Addr -> Addr
component (Name -> Addr
forall (m :: Type -> Type). Quote m => Name -> m Exp
varE Name
addr) Addr
wr) |]
    (DecsQ, MonoidalMap Name [Addr], [Addr])
-> ReaderT
     (Addr, Addr)
     (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
     ()
forall w (m :: Type -> Type). MonadWriter w m => w -> m ()
tell (DecsQ
decs, Name -> [Addr] -> MonoidalMap Name [Addr]
forall k a. k -> a -> MonoidalMap k a
Map.singleton Name
addr [Addr]
forall a. Monoid a => a
mempty, [Addr]
forall a. Monoid a => a
mempty)
    (Handle addr', Result)
-> ReaderT
     (Addr, Addr)
     (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q)
     (Handle addr', Result)
forall a.
a
-> ReaderT
     (Addr, Addr) (WriterT (DecsQ, MonoidalMap Name [Addr], [Addr]) Q) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Name -> Name -> Handle addr'
forall addr. Name -> Name -> Handle addr
Handle Name
rd Name
addr, Addr -> Result
Result (Name -> Addr
forall (m :: Type -> Type). Quote m => Name -> m Exp
varE Name
result))

readWrite_
    :: forall addr' addr. ()
    => (Addr -> Dat -> Dat)
    -> Addressing addr (Handle addr')
readWrite_ :: forall addr' addr.
(Addr -> Addr -> Addr) -> Addressing addr (Handle addr')
readWrite_ Addr -> Addr -> Addr
component = ((Handle addr', Result) -> Handle addr')
-> Addressing addr (Handle addr', Result)
-> Addressing addr (Handle addr')
forall a b. (a -> b) -> Addressing addr a -> Addressing addr b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Handle addr', Result) -> Handle addr'
forall a b. (a, b) -> a
fst (Addressing addr (Handle addr', Result)
 -> Addressing addr (Handle addr'))
-> Addressing addr (Handle addr', Result)
-> Addressing addr (Handle addr')
forall a b. (a -> b) -> a -> b
$ (Addr -> Addr -> Addr) -> Addressing addr (Handle addr', Result)
forall addr' addr.
(Addr -> Addr -> Addr) -> Addressing addr (Handle addr', Result)
readWrite ((Addr -> Addr -> Addr) -> Addressing addr (Handle addr', Result))
-> (Addr -> Addr -> Addr) -> Addressing addr (Handle addr', Result)
forall a b. (a -> b) -> a -> b
$ \Addr
addr Addr
wr -> [| ($(Addr -> Addr -> Addr
component Addr
addr Addr
wr), ()) |]

conduit
    :: forall addr' addr. ()
    => ExpQ
    -> Addressing addr (Handle addr', Result, Result)
conduit :: forall addr' addr.
Addr -> Addressing addr (Handle addr', Result, Result)
conduit Addr
rdExt = do
    (Handle addr'
h, Result Addr
x) <- (Addr -> Addr -> Addr) -> Addressing addr (Handle addr', Result)
forall addr' addr.
(Addr -> Addr -> Addr) -> Addressing addr (Handle addr', Result)
readWrite ((Addr -> Addr -> Addr) -> Addressing addr (Handle addr', Result))
-> (Addr -> Addr -> Addr) -> Addressing addr (Handle addr', Result)
forall a b. (a -> b) -> a -> b
$ \Addr
addr Addr
wr -> [| ($Addr
rdExt, ($Addr
addr, $Addr
wr)) |]
    (Handle addr', Result, Result)
-> Addressing addr (Handle addr', Result, Result)
forall a. a -> Addressing addr a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Handle addr'
h, Addr -> Result
Result [| fst $Addr
x |], Addr -> Result
Result [| snd $Addr
x |])

romFromVec
    :: (1 <= n)
    => SNat n
    -> ExpQ {-(Vec n dat)-}
    -> Addressing addr (Handle (Index n))
romFromVec :: forall (n :: Natural) addr.
(1 <= n) =>
SNat n -> Addr -> Addressing addr (Handle (Index n))
romFromVec SNat n
size Addr
xs = (Addr -> Addr -> Addr) -> Addressing addr (Handle (Index n))
forall addr' addr.
(Addr -> Addr -> Addr) -> Addressing addr (Handle addr')
readWrite_ ((Addr -> Addr -> Addr) -> Addressing addr (Handle (Index n)))
-> (Addr -> Addr -> Addr) -> Addressing addr (Handle (Index n))
forall a b. (a -> b) -> a -> b
$ \Addr
addr Addr
_wr ->
    [| rom $Addr
xs (bitCoerce . fromJustX <$> $Addr
addr) |]

romFromFile
    :: (1 <= n)
    => SNat n
    -> ExpQ
    -> Addressing addr (Handle (Index n))
romFromFile :: forall (n :: Natural) addr.
(1 <= n) =>
SNat n -> Addr -> Addressing addr (Handle (Index n))
romFromFile SNat n
size Addr
fileName = (Addr -> Addr -> Addr) -> Addressing addr (Handle (Index n))
forall addr' addr.
(Addr -> Addr -> Addr) -> Addressing addr (Handle addr')
readWrite_ ((Addr -> Addr -> Addr) -> Addressing addr (Handle (Index n)))
-> (Addr -> Addr -> Addr) -> Addressing addr (Handle (Index n))
forall a b. (a -> b) -> a -> b
$ \Addr
addr Addr
_wr ->
    [| fmap unpack $ romFilePow2 $Addr
fileName (bitCoerce . fromJustX <$> $Addr
addr) |]

ram0
    :: (1 <= n)
    => SNat n
    -> Addressing addr (Handle (Index n))
ram0 :: forall (n :: Natural) addr.
(1 <= n) =>
SNat n -> Addressing addr (Handle (Index n))
ram0 SNat n
size = (Addr -> Addr -> Addr) -> Addressing addr (Handle (Index n))
forall addr' addr.
(Addr -> Addr -> Addr) -> Addressing addr (Handle addr')
readWrite_ ((Addr -> Addr -> Addr) -> Addressing addr (Handle (Index n)))
-> (Addr -> Addr -> Addr) -> Addressing addr (Handle (Index n))
forall a b. (a -> b) -> a -> b
$ \Addr
addr Addr
wr ->
    [| blockRam1 NoClearOnReset size 0 (fromJustX <$> $Addr
addr) (liftA2 (,) <$> $Addr
addr <*> $Addr
wr) |]

ramFromFile
    :: SNat n
    -> ExpQ {- FilePath -}
    -> Addressing addr (Handle (Index n))
ramFromFile :: forall (n :: Natural) addr.
SNat n -> Addr -> Addressing addr (Handle (Index n))
ramFromFile SNat n
size Addr
fileName = (Addr -> Addr -> Addr) -> Addressing addr (Handle (Index n))
forall addr' addr.
(Addr -> Addr -> Addr) -> Addressing addr (Handle addr')
readWrite_ ((Addr -> Addr -> Addr) -> Addressing addr (Handle (Index n)))
-> (Addr -> Addr -> Addr) -> Addressing addr (Handle (Index n))
forall a b. (a -> b) -> a -> b
$ \Addr
addr Addr
wr ->
    [| packRam (blockRamFile size $Addr
fileName)
           (fromJustX <$> $Addr
addr)
           (liftA2 (,) <$> $Addr
addr <*> $Addr
wr)
    |]

port
    :: forall addr' a addr. ()
    => ExpQ
    -> Addressing addr (Handle addr', Result)
port :: forall addr' a addr. Addr -> Addressing addr (Handle addr', Result)
port Addr
mkPort = (Addr -> Addr -> Addr) -> Addressing addr (Handle addr', Result)
forall addr' addr.
(Addr -> Addr -> Addr) -> Addressing addr (Handle addr', Result)
readWrite ((Addr -> Addr -> Addr) -> Addressing addr (Handle addr', Result))
-> (Addr -> Addr -> Addr) -> Addressing addr (Handle addr', Result)
forall a b. (a -> b) -> a -> b
$ \Addr
addr Addr
wr ->
  [| let (read, x) = $Addr
mkPort $ portFromAddr $Addr
addr $Addr
wr
     in (delay undefined read, x)
  |]

port_
    :: forall addr' addr. ()
    => ExpQ
    -> Addressing addr (Handle addr')
port_ :: forall addr' addr. Addr -> Addressing addr (Handle addr')
port_ Addr
mkPort = (Addr -> Addr -> Addr) -> Addressing addr (Handle addr')
forall addr' addr.
(Addr -> Addr -> Addr) -> Addressing addr (Handle addr')
readWrite_ ((Addr -> Addr -> Addr) -> Addressing addr (Handle addr'))
-> (Addr -> Addr -> Addr) -> Addressing addr (Handle addr')
forall a b. (a -> b) -> a -> b
$ \Addr
addr Addr
wr ->
  [| let read = $Addr
mkPort $ portFromAddr $Addr
addr $Addr
wr
     in delay undefined read
  |]

from
    :: forall addr' addr a. (Typeable addr', Lift addr)
    => (Integral addr, Ord addr, Integral addr', Bounded addr')
    => addr
    -> Addressing addr' a
    -> Addressing addr a
from :: forall addr' addr a.
(Typeable addr', Lift addr, Integral addr, Ord addr,
 Integral addr', Bounded addr') =>
addr -> Addressing addr' a -> Addressing addr a
from addr
base = Addr -> Addressing addr' a -> Addressing addr a
forall addr' a addr.
Addr -> Addressing addr' a -> Addressing addr a
matchAddr [| from' @($(forall t. Typeable t => Q Type
forall {k} (t :: k). Typeable t => Q Type
liftTypeQ @addr')) base |]

tag
    :: (Lift addr')
    => addr'
    -> Addressing (addr', addr) a
    -> Addressing addr a
tag :: forall addr' addr a.
Lift addr' =>
addr' -> Addressing (addr', addr) a -> Addressing addr a
tag addr'
t = Addr -> Addressing (addr', addr) a -> Addressing addr a
forall addr' a addr.
Addr -> Addressing addr' a -> Addressing addr a
matchAddr [| \addr -> Just (t, addr) |]

matchJust
    :: Addressing addr a
    -> Addressing (Maybe addr) a
matchJust :: forall addr a. Addressing addr a -> Addressing (Maybe addr) a
matchJust = Addr -> Addressing addr a -> Addressing (Maybe addr) a
forall addr' a addr.
Addr -> Addressing addr' a -> Addressing addr a
matchAddr [| id |]

matchLeft
    :: Addressing addr1 a
    -> Addressing (Either addr1 addr2) a
matchLeft :: forall addr1 a addr2.
Addressing addr1 a -> Addressing (Either addr1 addr2) a
matchLeft = Addr -> Addressing addr1 a -> Addressing (Either addr1 addr2) a
forall addr' a addr.
Addr -> Addressing addr' a -> Addressing addr a
matchAddr [| either Just (const Nothing) |]

matchRight
    :: Addressing addr2 a
    -> Addressing (Either addr1 addr2) a
matchRight :: forall addr2 a addr1.
Addressing addr2 a -> Addressing (Either addr1 addr2) a
matchRight = Addr -> Addressing addr2 a -> Addressing (Either addr1 addr2) a
forall addr' a addr.
Addr -> Addressing addr' a -> Addressing addr a
matchAddr [| either (const Nothing) Just |]

from'
    :: forall addr' addr. (Integral addr, Ord addr, Integral addr', Bounded addr')
    => addr -> addr -> Maybe addr'
from' :: forall addr' addr.
(Integral addr, Ord addr, Integral addr', Bounded addr') =>
addr -> addr -> Maybe addr'
from' addr
base addr
addr = do
    Bool -> Maybe ()
forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ addr
addr addr -> addr -> Bool
forall a. Ord a => a -> a -> Bool
>= addr
base
    let offset :: addr
offset = addr
addr addr -> addr -> addr
forall a. Num a => a -> a -> a
- addr
base
    Bool -> Maybe ()
forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ addr
offset addr -> addr -> Bool
forall a. Ord a => a -> a -> Bool
<= addr' -> addr
forall a b. (Integral a, Num b) => a -> b
fromIntegral (addr'
forall a. Bounded a => a
maxBound :: addr')
    addr' -> Maybe addr'
forall a. a -> Maybe a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (addr -> addr'
forall a b. (Integral a, Num b) => a -> b
fromIntegral addr
offset)