never executed always true always false

    1 module HelVM.HelMA.Automaton.Combiner.LSU where
    2 
    3 import           HelVM.HelMA.Automaton.Combiner.ALU
    4 import qualified HelVM.HelMA.Automaton.Combiner.RAM                     as RAM
    5 
    6 import           HelVM.HelMA.Automaton.IO.BusinessIO
    7 
    8 import           HelVM.HelMA.Automaton.Instruction.Extras.Common
    9 import           HelVM.HelMA.Automaton.Instruction.Groups.IOInstruction
   10 import           HelVM.HelMA.Automaton.Instruction.Groups.LSInstruction
   11 
   12 import           HelVM.HelIO.Control.Safe
   13 
   14 import           Control.Type.Operator
   15 
   16 runSLI :: (LSU m s r element) => LSInstruction -> LoadStoreMemory s r -> m $ LoadStoreMemory s r
   17 runSLI Load             = load
   18 runSLI Store            = store
   19 runSLI (LoadD     a)    = loadD a
   20 runSLI (StoreID v a)    = storeID v a
   21 runSLI (MoveD   s d)    = moveD s d
   22 runSLI (MIO OutputChar) = loadOutputChar
   23 runSLI (MIO OutputDec)  = loadOutputDec
   24 runSLI (MIO InputChar)  = storeInputChar
   25 runSLI (MIO InputDec)   = storeInputDec
   26 
   27 load :: LSU m s r element => LoadStoreMemory s r -> m $ LoadStoreMemory s r
   28 load (LSM s r) = appendError "LSM.load" $ build =<< pop1 s where
   29   build (address , s') = loadPure address $ LSM s' r
   30 
   31 loadD :: LSU m s r element => Index -> LoadStoreMemory s r -> m $ LoadStoreMemory s r
   32 loadD address = loadPure (fromIntegral address)
   33 
   34 loadPure :: LSU m s r element => element -> LoadStoreMemory s r -> m $ LoadStoreMemory s r
   35 loadPure address (LSM s r) = pure $ LSM (push1 (RAM.genericLoad r address) s) r
   36 
   37 store :: LSU m s r element => LoadStoreMemory s r -> m $ LoadStoreMemory s r
   38 store (LSM s r) = appendError "LSM.store" $ build =<< pop2 s where
   39   build (value , address , s') = storePure value address $ LSM s' r
   40 
   41 storeID :: LSU m s r element => Integer -> Index -> LoadStoreMemory s r -> m $ LoadStoreMemory s r
   42 storeID value address = storePure (fromIntegral value) (fromIntegral address)
   43 
   44 storePure :: LSU m s r element => element -> element -> LoadStoreMemory s r -> m $ LoadStoreMemory s r
   45 storePure value address (LSM s r) = pure $ LSM s $ RAM.store address value r
   46 
   47 moveD :: LSU m s r element => Index -> Index -> LoadStoreMemory s r -> m $ LoadStoreMemory s r
   48 moveD src dst lsm@(LSM _ r) = storePure (RAM.genericLoad r src) (fromIntegral dst) lsm
   49 
   50 -- | IO
   51 
   52 loadOutputChar :: LSU m s r element => LoadStoreMemory s r -> m $ LoadStoreMemory s r
   53 loadOutputChar (LSM s r) = appendError "LSM.loadOutputChar" $ build =<< pop1 s where
   54   build (address , s') = LSM s' r <$ wPutAsChar (RAM.genericLoad r address)
   55 
   56 loadOutputDec :: LSU m s r element => LoadStoreMemory s r -> m $ LoadStoreMemory s r
   57 loadOutputDec (LSM s r) = appendError "LSM.loadOutputDec" $ build =<< pop1 s where
   58   build (address , s') = LSM s' r <$ wPutAsDec (RAM.genericLoad r address)
   59 
   60 storeInputChar :: LSU m s r element => LoadStoreMemory s r -> m $ LoadStoreMemory s r
   61 storeInputChar (LSM s r) = appendError "LSM.storeInputChar" $ build =<< pop1 s where
   62   build (address , s') = LSM s' . flip (RAM.store address) r <$> wGetCharAs
   63 
   64 storeInputDec :: LSU m s r element => LoadStoreMemory s r -> m $ LoadStoreMemory s r
   65 storeInputDec (LSM s r) = appendError "LSM.storeInputDec" $ build =<< pop1 s where
   66   build (address , s') = LSM s' . flip (RAM.store address) r <$> wGetDecAs
   67 
   68 -- | Types
   69 type LSU m s r element = (ALU m s element , RAM.RAM r element)
   70 
   71 data LoadStoreMemory s r = LSM
   72   { stack :: s
   73   , ram   :: r
   74   }