never executed always true always false

    1 module HelVM.HelMA.Automata.Piet.Types.Memory (
    2   stepWhitePixel,
    3   programMemory,
    4   positionMemory,
    5   orientationMemory,
    6   initialMemory,
    7   setInstructionCounter,
    8   Memory (..),
    9   Stack,
   10 ) where
   11 
   12 import           HelVM.HelMA.Automata.Piet.Types.CodelChooser
   13 import           HelVM.HelMA.Automata.Piet.Types.Coordinates
   14 import           HelVM.HelMA.Automata.Piet.Types.DirectionPointer
   15 import           HelVM.HelMA.Automata.Piet.Types.InstructionCounter
   16 import           HelVM.HelMA.Automata.Piet.Types.InstructionMemory
   17 import           HelVM.HelMA.Automata.Piet.Types.Orientation
   18 import           HelVM.HelMA.Automata.Piet.Types.Program
   19 
   20 import qualified Data.Sequence                                      as Seq
   21 
   22 import           Prelude                                            hiding (empty)
   23 
   24 stepWhitePixel :: Memory -> Memory
   25 stepWhitePixel mem = handleBlocked (isBlocked nextPos prog) nextPos dp mem where
   26   prog    = programMemory mem
   27   nextPos = addCoordinates dp $ positionMemory mem
   28   dp      = directionPointerMemory mem
   29 
   30 -- INITIALIZERS & CONSTRUCTORS
   31 
   32 initialMemory :: Program -> Memory
   33 initialMemory prog = Memory
   34   { instructionMemory = initialInstructionMemory prog
   35   , stack             = Seq.empty
   36   }
   37 
   38 -- GETTERS
   39 
   40 programMemory :: Memory -> Program
   41 programMemory = program . instructionMemory
   42 
   43 instructionCounterMemory :: Memory -> InstructionCounter
   44 instructionCounterMemory = instructionCounter . instructionMemory
   45 
   46 directionPointerMemory :: Memory -> DirectionPointer
   47 directionPointerMemory = directionPointer . orientationMemory
   48 
   49 codelChooserMemory :: Memory -> CodelChooser
   50 codelChooserMemory = codelChooser . orientationMemory
   51 
   52 positionMemory :: Memory -> Coordinates
   53 positionMemory = position . instructionCounterMemory
   54 
   55 orientationMemory :: Memory -> Orientation
   56 orientationMemory = orientation . instructionCounterMemory
   57 
   58 -- SETTERS
   59 
   60 setInstructionMemory :: InstructionMemory -> Memory -> Memory
   61 setInstructionMemory im mem = mem { instructionMemory = im }
   62 
   63 setInstructionCounter :: InstructionCounter -> Memory -> Memory
   64 setInstructionCounter ic mem = setInstructionMemory ((instructionMemory mem) { instructionCounter = ic }) mem
   65 
   66 setPosition :: Coordinates -> Memory -> Memory
   67 setPosition pos mem = setInstructionCounter ((instructionCounterMemory mem) { position = pos }) mem
   68 
   69 setDirectionPointer :: DirectionPointer -> Memory -> Memory
   70 setDirectionPointer dp mem = setOrientation ((orientationMemory mem) { directionPointer = dp }) mem
   71 
   72 setCodelChooser :: CodelChooser -> Memory -> Memory
   73 setCodelChooser cc mem = setOrientation ((orientationMemory mem) { codelChooser = cc }) mem
   74 
   75 setOrientation :: Orientation -> Memory -> Memory
   76 setOrientation reg mem = setInstructionCounter ((instructionCounterMemory mem) { orientation = reg }) mem
   77 
   78 -- OPERATIONS & MODIFIERS
   79 
   80 handleBlocked :: Bool -> Coordinates -> DirectionPointer -> Memory -> Memory
   81 handleBlocked True  _       dp = rotateAndToggle dp
   82 handleBlocked False nextPos _  = setPosition nextPos
   83 
   84 rotateAndToggle :: DirectionPointer -> Memory -> Memory
   85 rotateAndToggle dp mem = setCodelChooser (toggle 1 (codelChooserMemory mem)) $ setDirectionPointer (rotate 1 dp) mem
   86 
   87 -- DATA TYPES
   88 
   89 data Memory = Memory
   90   { instructionMemory :: InstructionMemory
   91   , stack             :: !Stack
   92   }
   93 
   94 type Stack = Seq Int