help implementing change in control flow

[smunix]

Anyone knows how to implement an interpreter for the Asm Effect below?

type Reg = Int

data Asm :: Effect where 
  Later :: Asm m a -> Asm m a
  WithReg :: (Reg -> Asm m a) -> Asm m a

type instance DispatchOf Asm = Dynamic

later :: (Asm :> es) => Asm (Eff es) a -> Eff es a
later = send . Later

withReg :: (Asm :> es) => (Reg -> Asm (Eff es) a) -> Eff es a
withReg = send . WithReg 

The expected semantics is that with Later or WithReg, we should interpret the underlying effect first. I'm new to effectful and effect libraries in general, so I'm not sure how to handle this.

I've tried the code below, but I'm not sure how to proceed next:

run :: Eff (Asm : es) a -> Eff es a
run = reinterpret (runReader $ mkReg 0) \ -> \case 
  Later m -> _whatNext1 -- how do we interpret `m`???
  WithReg kont -> do 
    reg <- get @Reg
    _whatNext2 $ kont reg -- how to continue ?

[smunix]

Looking how CatchError is interpreted, I believe I may need to do the same thing as here

[arybczak]

Indeed, you need to use one of the functions from the localUnlift family.

Btw, reading introduction to the Effectful.Dispatch.Dynamic module should help you in general.

[smunix]

@arybczak thank you! Reading through Effectful.Dispatch.Dynamic had it solved indeed. Here's the final version of the chip-8 assembler effect that works (makeEffect is absolutely fantastic):

data Asm :: Effect where
  Op :: Op -> Asm m () -- `Op` is the ASM instruction
  Here :: Asm m Addr -- take a label on the current position
  WithReg :: (Reg -> m a) -> Asm m a -- alloc new register

makeEffect ''Asm

Its interpreter looks like below:

run :: (IOE :> es, Fail :> es, Foldable f) => Addr -> f Reg -> (Addr -> Op -> IO ()) -> Eff (Asm : es) a -> Eff es a
run a00 (setOf folded -> regs) pp = reinterpret (runReader regs . evalState a00) \env -> \case
  Op o -> do
    loc <- get @Addr
    liftIO $ pp loc o
    modify @Addr (`D.add` (2 :: Byte))
  Here -> get @Addr
  WithReg kont -> do
    asks @Regs Set.minView >>= maybe (fail "register allocation failed") \(r, regs') ->
      local (const regs') $ localSeqUnliftIO env \unlift -> do
        unlift $ kont r

With this in place, I was able to write a tiny ASM program for the chip-8 VM:

registers :: [Reg]
registers = [0 .. 0xf]

asm :: Eff [Asm.Asm, Fail, IOE] ()
asm = do
  -- alloc register
  Asm.withReg \r0 -> do
    -- define function "fun1"
    fun1 <- Asm.function do
      Asm.withReg \r1 -> do
        -- save R0 into R1
        Asm.movR r1 r0
        -- Loop from 0 to 5
        Asm.forEach (0, 5) \count -> do
          Asm.movR r0 count
        -- restore R0 from R1
        Asm.movR r0 r1

    -- define function "fun2"
    fun2 <- Asm.function do
      Asm.withReg \r1 -> do
        Asm.movR r1 r0
        Asm.forEach (0, 6) \_count -> do
          Asm.call fun1
        Asm.movR r0 r1

    -- define function "main"
    main <- Asm.function do
      Asm.forEach (0, 10) \_count -> do
        Asm.call fun2

    Asm.call main

Running this program with print =<< (runEff . runFail . Asm.run 0 registers (curry print)) asm produces a good looking ASM code:

((addr <0x0>),MovRR (reg <0x1>) (reg <0x0>))
((addr <0x2>),MovRI (reg <0x2>) (byte <0x0>))
((addr <0x4>),MovRR (reg <0x0>) (reg <0x2>))
((addr <0x6>),AddRI (reg <0x2>) (byte <0x1>))
((addr <0x8>),SkipEqRI (reg <0x2>) (byte <0x4>))
((addr <0xa>),Jump (addr <0x4>))
((addr <0xc>),MovRR (reg <0x0>) (reg <0x1>))
((addr <0xe>),Return)
((addr <0x10>),MovRR (reg <0x1>) (reg <0x0>))
((addr <0x12>),MovRI (reg <0x2>) (byte <0x0>))
((addr <0x14>),Call (addr <0x0>))
((addr <0x16>),AddRI (reg <0x2>) (byte <0x1>))
((addr <0x18>),SkipEqRI (reg <0x2>) (byte <0x5>))
((addr <0x1a>),Jump (addr <0x14>))
((addr <0x1c>),MovRR (reg <0x0>) (reg <0x1>))
((addr <0x1e>),Return)
((addr <0x20>),MovRI (reg <0x1>) (byte <0x0>))
((addr <0x22>),Call (addr <0x10>))
((addr <0x24>),AddRI (reg <0x1>) (byte <0x1>))
((addr <0x26>),SkipEqRI (reg <0x1>) (byte <0x9>))
((addr <0x28>),Jump (addr <0x22>))
((addr <0x2a>),Return)
((addr <0x2c>),Call (addr <0x20>))

And a slightly different interpretation produces the bytecode below:

((addr <0x0>),[(byte <0x81>),(byte <0x0>)])
((addr <0x2>),[(byte <0x62>),(byte <0x0>)])
((addr <0x4>),[(byte <0x80>),(byte <0x20>)])
((addr <0x6>),[(byte <0x72>),(byte <0x1>)])
((addr <0x8>),[(byte <0x32>),(byte <0x4>)])
((addr <0xa>),[(byte <0x10>),(byte <0x4>)])
((addr <0xc>),[(byte <0x80>),(byte <0x10>)])
((addr <0xe>),[(byte <0x0>),(byte <0xee>)])
((addr <0x10>),[(byte <0x81>),(byte <0x0>)])
((addr <0x12>),[(byte <0x62>),(byte <0x0>)])
((addr <0x14>),[(byte <0x20>),(byte <0x0>)])
((addr <0x16>),[(byte <0x72>),(byte <0x1>)])
((addr <0x18>),[(byte <0x32>),(byte <0x5>)])
((addr <0x1a>),[(byte <0x10>),(byte <0x14>)])
((addr <0x1c>),[(byte <0x80>),(byte <0x10>)])
((addr <0x1e>),[(byte <0x0>),(byte <0xee>)])
((addr <0x20>),[(byte <0x61>),(byte <0x0>)])
((addr <0x22>),[(byte <0x20>),(byte <0x10>)])
((addr <0x24>),[(byte <0x71>),(byte <0x1>)])
((addr <0x26>),[(byte <0x31>),(byte <0x9>)])
((addr <0x28>),[(byte <0x10>),(byte <0x22>)])
((addr <0x2a>),[(byte <0x0>),(byte <0xee>)])
((addr <0x2c>),[(byte <0x20>),(byte <0x20>)])

Hopefully this will help as an example for anyone facing the same issue.