{-# 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 = ExpQ
type Dat = ExpQ
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
-> 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
-> 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
-> 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)