never executed always true always false

    1 module HelVM.HelMA.Automaton.Combiner where
    2 
    3 import           HelVM.HelMA.Automaton.Eff.AutomatonEff
    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 ∷ (SRAutomatonEff 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 ∷ (SRAutomatonEff 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 ∷ (SRAutomatonEff 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
   83   = Memory
   84       { memoryCM    :: ControlMemory
   85       , memoryStack :: s
   86       , memoryRAM   :: r
   87       }
   88   deriving stock (Show)