never executed always true always false

    1 module HelVM.HelMA.Automaton.Combiner where
    2 
    3 import           HelVM.HelMA.Automaton.IO.AutomatonIO
    4 
    5 import           HelVM.HelMA.Automaton.Instruction
    6 
    7 import           HelVM.HelMA.Automaton.Trampoline     as Trampoline
    8 
    9 import           HelVM.HelMA.Automaton.Symbol
   10 
   11 import           HelVM.HelMA.Automaton.Combiner.ALU   as ALU
   12 import           HelVM.HelMA.Automaton.Combiner.CPU   as CPU
   13 import           HelVM.HelMA.Automaton.Combiner.LSU   as LSU
   14 
   15 import           Control.Type.Operator
   16 
   17 import           Prelude                              hiding (swap)
   18 
   19 -- | Core of Combiner
   20 
   21 runInstruction :: (SRAutomatonIO Symbol s r m) => Instruction -> SF s r m
   22 runInstruction (ISM      i) a = Trampoline.continue . updateStack   a <$> runALI i (memoryStack a)
   23 runInstruction (ILS      i) a = Trampoline.continue . updateFromLSM a <$> runSLI i (toLSM a)
   24 runInstruction (ICF      i) a = Trampoline.continue . updateFromCPM a <$> runCFI i (toCPM a)
   25 runInstruction  End         a = end a
   26 
   27 pop2ForStack :: (SRAutomatonIO Symbol s r m) => Memory s r -> m (Symbol , Symbol , Memory s r)
   28 pop2ForStack a = build <$> pop2 (memoryStack a) where
   29   build (s1 , s2 , s') = (s1 , s2 , updateStack a s')
   30 
   31 push1ForStack :: Stack s Symbol => Symbol -> Memory s r -> Memory s r
   32 push1ForStack e a = a { memoryStack = push1 e (memoryStack a) }
   33 
   34 end :: (SRAutomatonIO Symbol s r m) => SF s r m
   35 end = pure . Trampoline.break
   36 
   37 -- | Constructors
   38 
   39 flippedNewMemory :: (s , r) -> InstructionList -> Memory s r
   40 flippedNewMemory = flip (uncurry . newMemory)
   41 
   42 newMemory :: InstructionList -> s -> r -> Memory s r
   43 newMemory il = Memory (newCM il)
   44 
   45 -- | Updaters
   46 
   47 incrementIC :: Memory s r -> Memory s r
   48 incrementIC m = m { memoryCM = incrementPC $ memoryCM m}
   49 
   50 updateStack :: Memory s r -> s -> Memory s r
   51 updateStack m s = m {memoryStack = s}
   52 
   53 updateFromCPM :: Memory s r -> CentralProcessingMemory s -> Memory s r
   54 updateFromCPM m cpm = m { memoryCM = controlMemory cpm, memoryStack = alm cpm}
   55 
   56 updateFromLSM :: Memory s r -> LoadStoreMemory s r -> Memory s r
   57 updateFromLSM m lsu = m {memoryStack = stack lsu , memoryRAM = ram lsu}
   58 
   59 -- | Accessors
   60 
   61 memoryProgram :: Memory s r -> InstructionVector
   62 memoryProgram = program . memoryCM
   63 
   64 memoryProgramCounter :: Memory s r -> InstructionCounter
   65 memoryProgramCounter = programCounter . memoryCM
   66 
   67 toCPM :: Memory s r -> CentralProcessingMemory s
   68 toCPM a = CPM { controlMemory = memoryCM a , alm = memoryStack a }
   69 
   70 toLSM :: Memory s r -> LoadStoreMemory s r
   71 toLSM a = LSM { stack = memoryStack a, ram = memoryRAM a }
   72 
   73 -- | Types
   74 
   75 type SF s r m = Memory s r -> m $ MemorySame s r
   76 
   77 type F s r m = Memory s r -> m $ Memory s r
   78 
   79 type MemorySame s r = Same (Memory s r)
   80 
   81 -- | Data types
   82 data Memory s r = Memory
   83   { memoryCM    :: ControlMemory
   84   , memoryStack :: s
   85   , memoryRAM   :: r
   86   }
   87   deriving stock (Show)