never executed always true always false

    1 module HelVM.HelMA.Automata.SubLeq.Automaton (
    2   newMemory,
    3   run,
    4 ) where
    5 
    6 import           HelVM.HelMA.Automaton.IO.AutomatonIO
    7 import           HelVM.HelMA.Automaton.IO.BusinessIO
    8 
    9 import           HelVM.HelMA.Automaton.Trampoline     as Trampoline
   10 
   11 import           HelVM.HelMA.Automaton.Combiner.RAM   as RAM
   12 
   13 import           Control.Type.Operator
   14 
   15 run :: (RAutomatonIO e r m) => Maybe Natural -> Automaton e r -> m $ Automaton e r
   16 run = trampolineMWithLimit nextState
   17 
   18 nextState :: RAutomatonIO e r m => Automaton e r -> m $ AutomatonSame e r
   19 nextState a@(Automaton ic ram)
   20   | ic  < 0   = doEnd a
   21   | src < 0   = doInputChar   dst a
   22   | dst < 0   = doOutputChar  src a
   23   | otherwise = doInstruction src dst a
   24     where
   25       src  = genericLoad ram ic
   26       dst  = genericLoad ram $ ic + 1
   27 
   28 -- | IO instructions
   29 doOutputChar :: RAutomatonIO e r m => e -> Automaton e r -> m $ AutomatonSame e r
   30 doOutputChar address (Automaton ic ram) = wPutAsChar (genericLoad ram address) $> Trampoline.continue (next3Automaton ic ram)
   31 
   32 doInputChar :: RAutomatonIO e r m => e -> Automaton e r -> m $ AutomatonSame e r
   33 doInputChar address (Automaton ic ram) = Trampoline.continue . next3Automaton ic . flippedStoreChar address ram <$> wGetChar
   34 
   35 -- | Terminate instruction
   36 doEnd :: RAutomatonIO e r m => Automaton e r -> m $ AutomatonSame e r
   37 doEnd = pure . Trampoline.break
   38 
   39 doInstruction :: RAutomatonIO e r m => e -> e -> Automaton e r -> m $ AutomatonSame e r
   40 doInstruction src dst (Automaton ic ram) = pure $ Trampoline.continue $ Automaton ic' $ store dst diff ram where
   41   diff = genericLoad ram dst - genericLoad ram src
   42   ic'
   43     | diff <= 0 = genericLoad ram $ ic + 2
   44     | otherwise = ic + 3
   45 
   46 next3Automaton :: Num e => e -> ram -> Automaton e ram
   47 next3Automaton ic = Automaton (ic + 3)
   48 
   49 newMemory :: Num e => ram -> Automaton e ram
   50 newMemory = Automaton 0
   51 
   52 -- | Types
   53 
   54 type AutomatonSame ic ram = Same (Automaton ic ram)
   55 
   56 data Automaton ic ram = Automaton
   57    { memoryIC  :: ic
   58    , memoryRAM :: ram
   59    }
   60   deriving stock (Eq , Read , Show)