never executed always true always false

    1 module HelVM.HelMA.Automata.SubLeq.Automaton
    2   ( newMemory
    3   , runAutomat
    4   ) where
    5 
    6 import           HelVM.HelMA.Automaton.Eff.AutomatonEff
    7 import           HelVM.HelMA.Automaton.Eff.MonadEff
    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 runAutomat ∷ (RAutomatonEff e r m) ⇒ Maybe Natural → Automaton e r → m $ Automaton e r
   16 runAutomat = trampolineMWithLimit nextState
   17 
   18 nextState ∷ RAutomatonEff 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 ∷ RAutomatonEff e r m ⇒ e → Automaton e r → m $ AutomatonSame e r
   30 doOutputChar address (Automaton ic ram) = putAsChar (genericLoad ram address) $> Trampoline.continue (next3Automaton ic ram)
   31 
   32 doInputChar ∷ RAutomatonEff e r m ⇒ e → Automaton e r → m $ AutomatonSame e r
   33 doInputChar address (Automaton ic ram) = Trampoline.continue . next3Automaton ic . flippedStoreChar address ram <$> getChar
   34 
   35 -- | Terminate instruction
   36 doEnd ∷ RAutomatonEff e r m ⇒ Automaton e r → m $ AutomatonSame e r
   37 doEnd = pure . Trampoline.break
   38 
   39 doInstruction ∷ RAutomatonEff 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
   57   = Automaton
   58       { memoryIC  :: ic
   59       , memoryRAM :: ram
   60       }
   61   deriving stock (Eq, Read, Show)